Private WithEvents insp As Outlook.Inspectors 
 '--------------------------------------------------------------------------------------------
 ' Create an event handler to handle items being added to the inbox. See link below:
 '   https://msdn.microsoft.com/en-us/vba/outlook-vba/articles/using-events-with-automation
Private WithEvents Items As Outlook.Items 
 '
 ' Declare a public dictionary to load your email filtrs into (these can be defined directly
 ' in VB or loaded from a CSV or TXT file)
Public oSORT As Dictionary 
 '--------------------------------------------------------------------------------------------
 
Private Sub Application_Startup() 
     '--------------------------------------------------------------------------------------------
     ' Declare variables
    Dim olApp As Outlook.Application 
    Dim objNS As Outlook.NameSpace 
    Dim sPATH As String 
     '--------------------------------------------------------------------------------------------
     
     
     '--------------------------------------------------------------------------------------------
     ' If you're loading your email filters from a CSV file, create a filepath variable directing
     ' your code to the CSV. SortDict is a sub that loads two columns of CSV data into the public
     ' dictionary oSORT. It's important to load this on application startup and store as a public
     ' variable so the filters don't have to be reloaded every time a message is received.
     '
     ' Define your items as the collection of inbox items and use the ItemAdd event to trigger
     ' your code when a new email is received.
     
    Set oSORT = CreateObject("Scripting.Dictionary") 
    sPATH = "C:WorkDDEToolsOutlookFilters.csv" 
    Call SortDict(oSORT, sPATH) 
     
    Set olApp = Outlook.Application 
    Set objNS = olApp.GetNamespace("MAPI") 
     
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items 
     '--------------------------------------------------------------------------------------------
End Sub 
 
Private Sub SortDict(ByRef oDICT As Dictionary, sPATH As String) 
     '--------------------------------------------------------------------------------------------
     ' This code takes an empty dictionary object and a csv file destination and loads the csv
     ' data into the dictionary. sPATH has to be the destination of a csv file including the
     ' filename, and the csv has to contain two columns of data.
    Dim sARR() As String 
     
    Open sPATH For Input As #1 
    Do Until EOF(1) 
        Line Input #1, sVAR 
        sARR() = Split(sVAR, ",") 
        oDICT(sARR(0)) = sARR(1) 
    Loop 
    Close #1 
     '--------------------------------------------------------------------------------------------
End Sub 
 
Private Sub Items_ItemAdd(ByVal Item As Object) 
    On Error GoTo ErrorHandler 
     
     '----------------------------------------------------------------------------------------------
     ' Declare variables
    Dim Msg As Outlook.MailItem 
    Dim oNAMESPACE As Outlook.NameSpace 
    Dim oFOLDER As Outlook.Folder 
    Dim sVAR As String, sTO As String, sFROM As String 
    Dim sARR() As String 
    Dim recips As Outlook.Recipients 
    Dim recip As Outlook.Recipient 
    Dim i As Integer, k As Integer 
     '----------------------------------------------------------------------------------------------
     
     
     '----------------------------------------------------------------------------------------------
     ' - Confirm Item is an email
     ' - Retrieve sender's email address
     ' - Determine if sender's address is in a predefined filter list
     '   - Filter list is stored in a CSV file and read into a dictionary object. Left column of
     '       CSV file is a list of email addresses. Right column contains destination subfolders
     '       in the inbox. For multiple subfolder levels, each folder level must be specified and
     '       separated by semicolons. For example: 'Vendors;Walmart;Order Confirmations'
     ' - If sender's address is stored in the predefined list, move the incoming message to the
     '       destination folder
     ' - If sender's email isn't in filter list, iterate through recipients emails and perform
     '       the same check
    If TypeName(Item) = "MailItem" Then 
        Set Msg = Item 
        Set oNAMESPACE = Application.GetNamespace("MAPI") 
        Set oFOLDER = oNAMESPACE.GetDefaultFolder(olFolderInbox) 
         
         ' This code is incomplete. The sender's address is stored differently depending on whether the incoming
         ' email came from an exchange user or not. Haven't run into any bugs so far but I expect to.
         '        If Msg.SenderEmailType = "EX" Then
        sFROM = Msg.SenderEmailAddress 
         '        Else
         '            Set pa = Msg.Sender.PropertyAccessor
         '            sFROM = pa.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x39FE001E")
         '        End If
        If oSORT.Exists(sFROM) Then 
            If InStr(1, oSORT(sFROM), ";", vbTextCompare) Then 
                sARR() = Split(oSORT(sFROM), ";") 
                For i = LBound(sARR) To UBound(sARR) 
                    Set oFOLDER = oFOLDER.Folders(sARR(i)) 
                Next i 
            Else 
                Set oFOLDER = oFOLDER.Folders(oSORT(sFROM)) 
            End If 
            Msg.Move oFOLDER 
            Set oFOLDER = Nothing 
        Else 
            Set recips = Msg.Recipients 
            For Each recip In recips 
                Set pa = recip.PropertyAccessor 
                sTO = pa.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x39FE001E") 
                If oSORT.Exists(sTO) Then 
                    If InStr(1, oSORT(sTO), ";", vbTextCompare) Then 
                        sARR() = Split(oSORT(sTO), ";") 
                        For i = LBound(sARR) To UBound(sARR) 
                            Set oFOLDER = oFOLDER.Folders(sARR(i)) 
                        Next i 
                    Else 
                        Set oFOLDER = oFOLDER.Folders(oSORT(sTO)) 
                    End If 
                    Msg.Move oFOLDER 
                    Set oFOLDER = Nothing 
                    Exit For 
                End If 
            Next 
        End If 
    End If 
     '----------------------------------------------------------------------------------------------
     
     
     '----------------------------------------------------------------------------------------------
     ' Error trapping and exit.
ProgramExit: 
    Exit Sub 
ErrorHandler: 
    MsgBox Err.Number & " - " & Err.Description 
    Resume ProgramExit 
     '----------------------------------------------------------------------------------------------
End Sub