move email based on criteria - vba

[VeryForgetful]

Hi,

I'm trying to create some code to move email based on various criteria within my inbox.

The code needs to accomplish the following:

• Move email from inbox to urgent subfolder based on senderemailaddress, listed in column A.
• Move email from inbox to urgent subfolder based on a keyword found in senderemailaddress using a list of values located in column B. The code below attempts to find the name Smith in the address but it doesn't quite work for some reason.
• Move email from inbox to urgent subfolder based on a keyword found in the email body using a list of values located in column C.

Sub UrgentEmail()

'Use the Reference command on the Visual Basic for Applications (VBA) Tools menu
'to set a reference to Microsoft Outlook xx.x Object Library,

    Dim olApp As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim olInBox As Outlook.MAPIFolder
    Dim olMoveToFolder As Outlook.MAPIFolder
    Dim olItems As Outlook.Items

    Set olApp = CreateObject("Outlook.Application")
    Set olNS = olApp.GetNamespace("MAPI")
    Set olInBox = olNS.GetDefaultFolder(olFolderInbox)
    Set olMoveToFolder = olInBox.Folders("Urgent")    'change the name of the subfolder accordingly
    Set olItems = olInBox.Items
    For Each MyEmail In olItems
        If InStr(MyEmail.SenderEmailAddress, "smith") > 0 Then
            olItems(MyEmail).Move olMoveToFolder
        End If
    Next MyEmail
    Set olApp = Nothing
    Set olNS = Nothing
    Set olInBox = Nothing
    Set olMoveToFolder = Nothing
    Set olItems = Nothing
End Sub

Thanks

 

[VeryForgetful]

Anyone please?