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, _
                        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
        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
                        MoveMessage(CurrentRule.TargetPathOlkFolder, objMailItem, True)
                    End If
                End If
            End If
    End Sub

    Sub MoveMessage(ByVal strFolder As String, ByRef olkItem As Outlook.MailItem, _
                                                                              ByVal bAsk As Boolean)
        'See also
        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
                    dlgExistingRule = New DialogExistingRule
                    With dlgExistingRule
                        .txtFolderPath.Text = _
                                        Replace(.txtFolderPath.Text, "<SenderSearchString>", _
                        .txtFolderPath.Text = _
                                       Replace(.txtFolderPath.Text, "<TargetPathOlkFolder>", _
                        If .ShowDialog = Windows.Forms.DialogResult.OK Then
                            If .radioMoveMessage.Checked Then olkItem.Move(olkFolder)
                            If .radioIgnoreRule.Checked Then _
                            If .radioDeleteRule.Checked Then _
                            If .radioDisableQuickFiler.Checked Then bNoAction = True 
                        End If
                    End With
                    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

        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) _

        '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
        '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
        End If

        GetOlkFolder = objFolder
    End Function
End Class