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.

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.

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

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)
Dim oAccount As Outlook.Account

For Each oAccount In Application.Session.Accounts

'repeat for each account
If oAccount.DisplayName = "account name" 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

Next
End Sub

Google+

Diane Poremsky