Outlook VBA move sent mail based on SendAs address

Question

I am trying to move sent mail from my regular Sent Items standard folder to two separate folders in Outlook (365). On the left in my Folder Pane I have my email 'main@domain.com', 'Online Archive - main@domain.com' (an Online Archive for more storage similar to a PST I guess) and then a shared mailbox 'secondary@domain.com'.

One of the backup folders is in my Online Archive and the other backup folder is a shared mailbox. Here's the VBA code I have so far. Ideally I would like it to run each time an email is sent/appears in the Sent Items so I think I could use WithEvents somehow but I am okay to run the macro on an as needed basis.

When I run the code none of the mail moves so I think the issue is something with how I am selecting the filtered mail items to move.

Sub MoveItems()

Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim mySource As Outlook.MAPIFolder
Dim myDestFolder As Outlook.MAPIFolder
Dim myItems As Outlook.Items
Dim myItem As Object

Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set mySource = myNameSpace.GetDefaultFolder(olFolderSentMail)
Set myItems = mySource.Items

    Set myDestFolder = Outlook.Session.Folders("Online Archive - main@domain.com").Folders("Backup")
    Set myItem = myItems.Find("[SenderEmailAddress] = 'main@domain.com'")
    
        While TypeName(myItem) <> "Nothing"
        myItem.Move myDestFolder
        Set myItem = myItems.FindNext
        Wend
       
    Set myItem = myItems.Find("[SenderEmailAddress] = 'secondary@domain.com'")
    Set myDestFolder = Outlook.Session.Folders("secondary@domain.com").Folders("SecondaryBackup")
        
        While TypeName(myItem) <> "Nothing"
        myItem.Move myDestFolder
        Set myItem = myItems.FindNext
        Wend

End Sub

See [Apply one of two results to incoming email with Item_Add](https://stackoverflow.com/questions/66453348/apply-one-of-two-results-to-incoming-email-with-item-add) — niton, Jan 28 '23 at 00:50
@niton I'm trying to do this to sent emails and not received ones. I'll see if I can use part of that on Monday. — jnjustice, Jan 28 '23 at 21:01
Replace `Set myItems = Session.GetDefaultFolder(olFolderInbox).items` with a reference to the sent mail folder. `Set myItems = Session.GetDefaultFolder(olFolderSentMail).items` — niton, Jan 28 '23 at 21:13
I already referenced `olFolderSentMail in the existing code that failed to run and the link there is about saving attachments not moving mail between folders. — jnjustice, Jan 28 '23 at 21:39
New conversation: There is nothing obviously wrong with your code. Edit the question post to indicate the problem. — niton, Jan 28 '23 at 23:28
Verify SenderEmailAddress is in SMTP not Exchange format. `Debug.Print ActiveExplorer.Selection(1).senderEmailAddress` — niton, Jan 29 '23 at 02:48
@niton yeah that's the issue. Debut.Print outputs the below where ??? is a random unique values specific to my outlook I assume `/O=EXCHANGELABS/OU=EXCHANGE ADMINISTRATIVE GROUP (???)/CN=RECIPIENTS/CN=??? — jnjustice, Jan 30 '23 at 13:57
@niton I updated the original post with the solution I discovered. Thanks again for the guidance. — jnjustice, Jan 30 '23 at 15:13
Good that you found a solution and posted an answer. I rolled your edit back so this post remains the question part of the Q & A. — niton, Jan 30 '23 at 17:10
Exchange address: https://stackoverflow.com/questions/16945487/ms-outlook-2010-senderemailaddress-returns-a-huge-string-of-characters — niton, Jan 30 '23 at 17:20

score 0 · Accepted Answer · answered Jan 30 '23 at 15:14

Sub MoveItems()

Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim mySource, myDestFolder As Outlook.MAPIFolder
Dim myItems As Outlook.Items
Dim myItem As Object
Dim strFilter As String

Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set mySource = myNameSpace.GetDefaultFolder(olFolderSentMail)
Set myItems = mySource.Items

strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:fromname" & Chr(34) & " like '%Main Display Name%'"

    Set myDestFolder = Outlook.Session.Folders("Online Archive - main@domain.com").Folders("Backup")
    Set myItem = myItems.Find(strFilter)
    
        While TypeName(myItem) <> "Nothing"
        myItem.Move myDestFolder
        Set myItem = myItems.FindNext
        Wend
        
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:fromname" & Chr(34) & " like '%Shared Box Display Name%'"

    Set myDestFolder = Outlook.Session.Folders("Shared Box Display Name").Folders("Backup")
    Set myItem = myItems.Find(strFilter)
    
        While TypeName(myItem) <> "Nothing"
        myItem.Move myDestFolder
        Set myItem = myItems.FindNext
        Wend

End Sub

score 0 · Answer 2 · answered Jan 30 '23 at 17:17

You may change to senderName if senderEmailAddress is not in SMTP format.

Sub MoveItems_senderName()

    Dim mySource As Folder
    Dim myDestFolder As Folder
    Dim myItems As Items
    Dim myItem As Object
    
    Set mySource = Session.GetDefaultFolder(olFolderSentMail)
    'mySource.Display
    
    Set myItems = mySource.Items

    Set myDestFolder = Session.Folders("Online Archive - main@domain.com").Folders("Backup")
    
    Debug.Print "senderName: " & senderName
    Set myItem = myItems.Find("[SenderName] = 'text from immediate pane'")
    
    While TypeName(myItem) <> "Nothing"
        myItem.Move myDestFolder
        Set myItem = myItems.FindNext
    Wend

End Sub

Outlook VBA move sent mail based on SendAs address

2 Answers2