Automatically move incoming emails by subject to sub folder in a shared mailbox

Question

We organize emails within a shared mailbox. There are folders for each area, then a sub folder for each specific location.

I am trying to check the subject line of incoming email to move the email to its proper folder.

The thing to look for in the subject line is similar to "%%-%%" the percents being letters. We have over 900 locations and I would like to not have to create 900 rules.

Sub MoveToFolder(Item As Outlook.MailItem)

    Dim Subject As String
    Subject = Item.Subject

    Dim FolderToMoveTo As Outlook.Folder
    Set FolderToMoveTo = GetFolder("KX-BH")

    If (CheckSubject(Subject, "KX-BH")) Then
        Item.Move (FolderToMoveTo)
    End If

End Sub


Function CheckSubject(Subject As String, PatternToCheck As String)

    Dim ObjRegExp As RegExp
    Dim ObjMatch As Match

    Set ObjRegExp = New RegExp
    ObjRegExp.Pattern = PatternToCheck

    If (ObjRegExp.Text(Subject) = True) Then
        CheckSubject = True
    End If

End Function


Function GetFolder(ByVal FolderName As String) As Outlook.Folder

    Dim ObjFolder As Outlook.Folder
    Set ObjFolder = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Folders(FolderName)
    Set GetFolder = ObjFolder

End Function

Answer 1

It looks like you are interested in the NewMailEx event of the Application class which is fired when a new item is received in the Inbox. The NewMailEx event fires when a new message arrives in the Inbox and before client rule processing occurs. You can use the Entry ID returned in the EntryIDCollection array to call the NameSpace.GetItemFromID method and process the item.

Public WithEvents outApp As Outlook.Application

Sub Intialize_Handler()
    Set outApp = Application
End Sub

Private Sub outApp_NewMailEx(ByVal EntryIDCollection As String)
   Dim mai As Outlook.MailItem
   Set mai = Application.Session.GetItemFromID(strEntryId)

   MsgBox mai.Subject

   MoveToFolder(mai)
End Sub