Use a macro to move IMAP account sent items

I hear from a lot of user's who don't like how Outlook handles sent items with an IMAP accounts. In older versions of Outlook, IMAP sent items use the local Sent Items folder. While Outlook 2007 and 2010 can be configured to use the IMAP sent folder, when you use a Send by email command in other applications, the sent item goes into the local data file, ignoring the account configuration. Outlook 2013 uses XLIST to determine the sent items folder, but if the IMAP server doesn't support XLIST, the sent item is saved locally.

This macro solves the problem by monitoring the sent items folder and moving sent messages to the desired folder.

Outlook 2013 users who want to move IMAP messages to a local pst file can use this macro too, however, it will not move the messages immediately. They need to sync down from the IMAP server first.

To use this macro, you need to use the GetFolderPath macro from GetFolderPath.

You'll also need to set macro security to low to test the macro.

Press Alt+F11 to open the VBA editor. Expand Project1 and Microsoft Outlook Objects then double click on ThisOutlookSession. Paste the code into ThisOutlookSession. GetFolderPath can be pasted below this macro or in a new module.

To use this with multiple accounts, copy the IF... End IF block and change the account name and folder path for each account.

The account name and the data file name are usually the same - in Outlook 2010, both are the email address by default.

You need to use the account name as seen in File, Account Settings (or in the From field if you have multiple accounts) and the data file name (and path to the Sent folder) as seen in the folder list.

Note: this macro will work with any account type.

These macros start when Outlook starts. To test it without restarting Outlook, click in the Application_Startup macro and click the Run button (or press F5).

Only move sent mail from one account

This macro checks the sender address and only moves mail sent from that address.

Private WithEvents Items As Outlook.Items
 
Private Sub Application_Startup()
    Set Items = Session.GetDefaultFolder(olFolderSentMail).Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)

If Item.SendUsingAccount = "alias@domain.com" Then
' Get the GetFolderPath function from http://slipstick.me/getfolderpath  
    Set MovePst = GetFolderPath("data file name\Inbox\Sent")
    Item.UnRead = False
    Item.Move MovePst
End If

End Sub

Multiple IMAP accounts in Outlook 2010 and older

If you are using multiple accounts in Outlook 2010 and older, you can use IF statements to selectively move messages.

Private WithEvents Items As Outlook.Items
 
Private Sub Application_Startup()
    Set Items = Session.GetDefaultFolder(olFolderSentMail).Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
' Get the GetFolderPath function from http://slipstick.me/getfolderpath  

If Item.SendUsingAccount = "alias@domain.com" Then
   Set MovePst = GetFolderPath("data file name\Inbox\Sent")

ElseIf Item.SendUsingAccount = "alias@domain1.com" Then
   Set MovePst = GetFolderPath("data file name1\Inbox\Sent")

ElseIf Item.SendUsingAccount = "alias@domain2.com" Then
   Set MovePst = GetFolderPath("data file name2\Inbox\Sent")

Else
 Exit Sub

    Item.UnRead = False
    Item.Move MovePst
End If

End Sub

  Item.UnRead = False
  Item.Move MovePst

You could also use Case statements to set the correct Move path.

Move all sent messages

This macro assumes you have only one IMAP account in Outlook 2013 (and it's set as default data file) or one or more accounts in Outlook 2013 and want to move the mail sent from all accounts to a different folder.

Outlook 2013 users who want to move IMAP messages to a local pst file can use this macro too, however, it will not move the messages immediately. Sent messages need to sync down from the IMAP server first.

Private WithEvents Items As Outlook.Items
 
Private Sub Application_Startup()
    Set Items = Session.GetDefaultFolder(olFolderSentMail).Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
' You need the GetFolderPath function from http://slipstick.me/getfolderpath  
    Set MovePst = GetFolderPath("data file name\Inbox\Sent")
    Item.UnRead = False
    Item.Move MovePst
End Sub