QuickFiler: an Outlook 2010 add-in to file quickly your mail
The processing of incoming mail messages can be a very challenging and time-consuming task. Outlook contains some built-in tools to help you with this. Grouping your messages in discussions is a very useful way to quickly scan related emails. By creating rules you can perform many actions automatically. Among others you can have your message moved to a folder on receiving. In Outlook 2010 also Quick Rules were introduced which makes the creation of rules a lot easier and more flexible.
Still it is not possible to have all mail in your Inbox being opened one-by-one to read and have it filed or deleted without having to perform several click actions. In real life you would empty your mailbox and skim through a pile of mail opening them one-by-one, throw away immediately uninteresting items and file the important ones.
This QuickFiler add-in makes it very easy to perform this kind of sorting of your incoming mail. The first time you move a message from your inbox to a folder a window will appear which allows you to create a QuickFiler rule. On receiving new mails from the same sender a window will appear which will allow you to repeat this action just by tapping on Enter.
If you move a mail for the first time to a folder a window will show which looks something like below.
Once a QuickFiler rule is created a window will appear each time when in your Inbox a message is selected that meets the conditions of the rule.
Download the Outlook 2010 QuickFiler add-in source files and setup.
The most essential source code is in ThisAddIn.vb and is listed below.
Public Class ThisAddIn
Dim WithEvents objInspectors As Outlook.Inspectors
Dim WithEvents objOpenInspector As Outlook.Inspector
Dim WithEvents objMailItem As Outlook.MailItem
Dim WithEvents myOlExp As Outlook.Explorer
Dim colRules As Rules
Dim CurrentRule As Rule
Dim bNoAction As Boolean
Dim dlgExistingRule As DialogExistingRule
Dim dlgCreateRule As DialogCreateRule
Private Sub ThisAddIn_Startup(ByVal sender As Object, _
ByVal e As System.EventArgs) Handles Me.Startup
colRules = New Rules 'rules are read from rules file
End Sub
Private Sub Application_Startup() Handles Application.Startup
objInspectors = Application.Inspectors
myOlExp = Application.ActiveExplorer
End Sub
Private Sub myOlExp_Activate() Handles myOlExp.Activate
If CurrentRule IsNot Nothing Then
MoveMessage(CurrentRule.TargetPathOlkFolder, objMailItem, True)
End If
CurrentRule = Nothing
objMailItem = Nothing
End Sub
Private Sub myOlExp_BeforeItemPaste(ByRef ClipboardContent As Object, _
ByVal Target As Microsoft.Office.Interop.Outlook.MAPIFolder, _
ByRef Cancel As Boolean) Handles myOlExp.BeforeItemPaste
Dim sRuleSenderName As String
If ClipboardContent.Count = 0 Then Exit Sub
With ClipboardContent.Item(1)
CurrentRule = colRules.FindRule(.SenderName)
If CurrentRule IsNot Nothing Then
'Search string is found in name sender
'Dont create another rule
'Cancel = False 'NB Don't set Cancel=False, it will actually do cancel??
Exit Sub
End If
dlgCreateRule = New DialogCreateRule
With dlgCreateRule
.txtFolderPath.Text = _
Replace(.txtFolderPath.Text, "<TargetPathOlkFolder>", Target.FolderPath)
.txtSenderSearchText.Text = ClipboardContent.Item(1).SenderName
If .ShowDialog = Windows.Forms.DialogResult.OK Then
If .radioCreateRule.Checked = True Then
sRuleSenderName = .txtSenderSearchText.Text
If sRuleSenderName <> "" Then
Dim r As New Rule(sRuleSenderName, Target.FolderPath, _
.chkOpenToRead.Checked)
colRules.Add(r)
End If
End If
If .radioDisableQuickFiler.Checked Then
bNoAction = True
End If
End If
End With
End With
End Sub
Private Sub myOlExp_SelectionChange() Handles myOlExp.SelectionChange
Dim oMail As Object
If bNoAction Then Exit Sub
'Only check messages in the Inbox folder
If myOlExp.CurrentFolder.Name <> _
Application.GetNamespace("MAPI") _
.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox).Name Then Exit Sub
If myOlExp.Selection.Count <> 1 Then Exit Sub
'see also:
'How To Get the Currently Selected Item in an Outlook Folder from Visual Basic
'http://support.microsoft.com/kb/240935
CurrentRule = Nothing
For Each oMail In myOlExp.Selection
If oMail.MessageClass = "IPM.Note" Then
objMailItem = oMail
CurrentRule = colRules.FindRule(objMailItem.SenderName)
If CurrentRule IsNot Nothing Then
If CurrentRule.OpenToRead = True Then
objMailItem.GetInspector.Activate() 'show mail in new window
Else
MoveMessage(CurrentRule.TargetPathOlkFolder, objMailItem, True)
End If
End If
End If
Next
End Sub
Sub MoveMessage(ByVal strFolder As String, ByRef olkItem As Outlook.MailItem, _
ByVal bAsk As Boolean)
'See also
'http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_22970838.html
Dim olkFolder As Outlook.MAPIFolder
olkFolder = GetOlkFolder(strFolder)
If olkFolder Is Nothing Then Exit Sub
If CurrentRule Is Nothing Then Exit Sub
If olkItem Is Nothing Then Exit Sub
If TypeName(olkFolder) = "MAPIFolder" _
Then Exit Sub 'ignore moving mail to the same folder
If olkItem.Parent.FullFolderPath = olkFolder.FolderPath Then Exit Sub
If bAsk = True Then
Try
dlgExistingRule = New DialogExistingRule
With dlgExistingRule
.txtFolderPath.Text = _
Replace(.txtFolderPath.Text, "<SenderSearchString>", _
CurrentRule.SenderSearchString)
.txtFolderPath.Text = _
Replace(.txtFolderPath.Text, "<TargetPathOlkFolder>", _
olkFolder.FolderPath)
If .ShowDialog = Windows.Forms.DialogResult.OK Then
If .radioMoveMessage.Checked Then olkItem.Move(olkFolder)
If .radioIgnoreRule.Checked Then _
colRules.IgnoreRuleThisSession(CurrentRule.SenderSearchString)
If .radioDeleteRule.Checked Then _
colRules.DeleteRule(CurrentRule.SenderSearchString)
If .radioDisableQuickFiler.Checked Then bNoAction = True
End If
End With
Catch
Select Case Err.Number
Case -347864822 '&HAB44010A ? 'item moved or deleted
Case Is <> 0
MsgBox(Err.Number & Err.Description & " in MoveMessage")
End Select
End Try
End If
End If
olkFolder = Nothing
olkItem = Nothing
End Sub
Public Function GetOlkFolder(ByVal strFolderPath As String) As Outlook.MAPIFolder
' strFolderPath needs to be something like
' "Public Folders\All Public Folders\Company\Sales" or
' "Personal Folders\Inbox\My Folder"
'See also http://www.gregthatcher.com/Scripts/VBA/Outlook/GetListOfStores.aspx
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim arrFolders As String()
Dim I As Long
Dim Item As Object
On Error Resume Next
'remove 2 leading backslashes before the root folder name
If Left(strFolderPath, 2) = "\\" Then strFolderPath = Mid(strFolderPath, 3)
strFolderPath = Replace(strFolderPath, "/", "\")
strFolderPath = Replace(strFolderPath, """", "")
arrFolders = Split(strFolderPath, "\")
'Get the root folder of the active store
objFolder = _
Application.GetNamespace("MAPI").GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox) _
.Store.GetRootFolder
'If this fails try to get the root folder from the argument strFolderPath which is read from
'rules file
'This could occur if the rules in the rules file were created with another Outlook
'installation
'and the name of the default store has been changed.
If objFolder Is Nothing Then
objFolder = Application.GetNamespace("MAPI").Folders(arrFolders(0))
End If
If Not objFolder Is Nothing Then
For I = 1 To UBound(arrFolders)
colFolders = objFolder.Folders
objFolder = Nothing
objFolder = colFolders.Item(arrFolders(I))
If objFolder Is Nothing Then
Exit For
End If
Next
End If
GetOlkFolder = objFolder
End Function
End Class