Moving emails to folders based on SenderName

Question

I have the following Visual Basic script that should move emails in my Inbox to specific folders but when I run it, nothing happens. I am very new to VBA so am a little confused as to why. Does anything stick out, or do you have any suggestions as how to find out why this is('nt) happening? Thanks!

Code:

Sub Move_Emails()
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(6)
Set myItems = myInbox.Items
Dim myItem As Outlook.MailItem
Dim MailItem As Object
Dim sn As String

For Each MailItem In myInbox.Items
    sn = MailItem.SenderName
    If sn = "John Doe" Then
        Set myDestFolder = myInbox.Folders("Folder1")
    ElseIf sn = "Jane Smith" Then
        Set myDestFolder = myInbox.Folders("Folder2")
    ElseIf sn = "Bob Jones" Then
        Set myDestFolder = myInbox.Folders("Folder3")
    End If
    Set myItem = myItems.Find("[SenderName] = sn")
    While TypeName(myItem) <> "Nothing"
        myItem.Move myDestFolder
        Set myItem = myItems.FindNext

    Wend
Next
End Sub

Answer 1

You need to change the way you set your myItem variable. In your code sn is a variable and if you put it inside quotation marks it's not converted to real sender name. So, instead of this line:

Set myItem = myItems.Find("[SenderName] = sn")

use this line:

Set myItem = myItems.Find("[SenderName]='" & sn & "'")

Edit regarding possible problem according to comments below... When you check for the name in this way:

If sn = "John Doe" Then

you check for exact name of John Doe including upper/lower cases. I suggest to change it in this way:

If Ucase(sn) = "JOHN DOE" Then

to avoid possible problems with names spelling. Do it for all checks in If statement.

Edit 2nd... I have just realised that you use incorrect loop for moving elements. If you move one element to other folder as a result you change the order of your looping when using For each loop. Therefore I suggest some more changes as described below in new complete code:

Sub Move_Emails_improved()
Dim myNamespace, myInbox, myItems ', myDestFolder- NEW CHANGED MOVED TO SEPARATE LINE BELOW
Set myNamespace = Application.GetNamespace("MAPI")
Set myInbox = myNamespace.GetDefaultFolder(6)   
Set myItems = myInbox.items
Dim myItem As Outlook.MailItem
Dim MailItem As Object
Dim sn As String

'NEW LINE BELOW
Dim myDestFolder As Folder
'here you need different kind of loop
Dim i as integer
For i = myInbox.items.Count To 1 Step -1   'loop goes from last to first element
    sn = myInbox.items(i).SenderName

    'first possible problem
    If Ucase(sn) = "JOHN DOE" Then
        Set myDestFolder = myInbox.folders("Folder1")

    'alternatively you could check name in this way
    ElseIf UCase(sn) Like "*JANE SMITH*" Then
        Set myDestFolder = myInbox.folders("Folder2")
    ElseIf sn = "Bob Jones" Then
        Set myDestFolder = myInbox.folders("Folder3")
    End If
    Set myItem = myItems.Find("[SenderName]='" & sn & "'")

    'here we need to check if folder is not set
    'NEW- THIS LINE IMPROVED
    While TypeName(myItem) <> "Nothing" And And Not myDestFolder Is Nothing
        myItem.Move myDestFolder
        Set myItem = myItems.FindNext
        'NEW LINE BELOW
        i = i - 1

    Wend
    'and set destination folder to nothing to eliminate all problems
    Set myDestFolder = Nothing
Next
End Sub

Hope it will work now.