Use a macro to move IMAP account sent items

Last reviewed on March 27, 2014

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.

Account and file names in OutlookYou 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)

'repeat for each account
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

To move sent messages to multiple folders, you can repeat the If / End If block in the code sample above or set the MovePst variable in each If statement, like so:

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

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

  Item.UnRead = False
  Item.Move MovePst

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

Written by

Diane Poremsky
A Microsoft Outlook Most Valuable Professional (MVP) since 1999, Diane is the author of several books, including Outlook 2013 Absolute Beginners Book. She also created video training CDs and online training classes for Microsoft Outlook. You can find her helping people online in Outlook Forums as well as in the Microsoft Answers and TechNet forums.

Please post long or more complicated questions at Outlookforums.

32 responses to “Use a macro to move IMAP account sent items”

  1. mville

    I tried this with multiple IMAP acoounts but all sent mail ends up in the first email account sent items folder only.

  2. mville

    Yes:

    For Each oAccount In Application.Session.Accounts

    If oAccount = "mail.com" Then
    Set MovePst = GetFolderPath("\\mail.com\Sent")
    Item.UnRead = False
    Item.Move MovePst
    End If

    If oAccount = "gmail.com" Then
    Set MovePst = GetFolderPath("\\gmail.com\[Gmail]\Sent Mail")
    Item.UnRead = False
    Item.Move MovePst
    End If

    Next

    This is in Outlook 2007, gmail.com sent mail ends up in the mail.com sent folder.

  3. mville

    Removed the \\ on the path. Still the same outcome. All sent items go to the first account's sent items folder.

    I have 3 other non-gmail accounts so would like to get this working.

  4. mville

    There are 6 .pst data files. The default .pst containing the default Sent Items folder for Outlook (created by my original POP3 account which has long been deleted) and one for each of the 5 IMAP accounts.

    With no code, the IMAP sent emails go to the default Sent Items folder in the default .pst and not the Sent Mail folder for each IMAP account, hence this code.

    After adding the code, any sent mail goes to the default Sent Items folder and the code in the Items_ItemAdd event is triggered.

    There are 5 accounts (one for each IMAP account) in Application.Session.Accounts, mail.com being the first.

    The mail is moved, but only to the first IMAP account listed. In this case the mail.com Sent folder. The code is definitely running.

  5. Nelson

    I'm sorry but I can't seem to get this to work in Outlook 2013. The mail in 'Sent Items (This computer only)' don't move to the 'Sent Items' folder I am pointing to. Macro security is disabled and debugging doesn't seem to find an error in the code. Clearly I am doing something wrong and I am a novice with this so any help is appreciated.

    Here is my code:

    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 = "PSI Email" Then
    Set MovePst = GetFolderPath("PSI Email\Sent Items")
    Item.UnRead = False
    Item.Move MovePst
    End If

    Next
    End Sub

    Sub Whatever()

    Dim Ns As Outlook.NameSpace
    Set Ns = Application.GetNamespace("MAPI")

    'use the default folder
    Set Items = Ns.GetDefaultFolder(olFolderSentMail).Items

    'do whatever

    End Sub

  6. Nelson

    Thanks for this but for some reason it still does not work. The emails are still in Sent Items (This computer only). Not sure what else to try.

  7. Nils

    I've also tried the code with no success. I'm using Windows 8, the german version of Outlook 2013 and Mailaccounts from gmx.de and 1und1.de - if that matters. Would love to see a working workaround for this isse.

  8. Nils

    No nothing.

  9. Nelson

    For myself I get absolutely no error messages, only that the messages do not move.

  10. David

    Thanks for this, but I'm having an issue with multiple accounts.

    Outlook 2013 this works great with one account. However, when I add another account, nothing happens when I send from the 2nd account. BUT, when I send from the first account this happens:

    1. the mail gets moved to the Sent boxes of BOTH accounts, and
    2. I get this error popup, even when sending from the first account:

    Mircosoft Visual Basic

    Run-time error '-2147221233 (8004010f)':

    the items were copied instead of moved because the original items cannot be deleted. The operation failed. An object cannot be found.

    When I debug, it's stopped next to the 2nd account line:

    Item.Move MovePst

    Here's my code:

    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 = "David IMAP" Then

    ' Get the GetFolderPath function from http://slipstick.me/getfolderpath
    Set MovePst = GetFolderPath("David IMAP\Inbox\Sent")
    Item.UnRead = False
    Item.Move MovePst
    End If

    If oAccount = "HostrupHR" Then

    ' Get the GetFolderPath function from http://slipstick.me/getfolderpath
    Set MovePst = GetFolderPath("HostrupHR\Inbox\Sent")
    Item.UnRead = False
    Item.Move MovePst
    End If

    Next
    End Sub

    Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
    Dim oFolder As Outlook.Folder
    Dim FoldersArray As Variant
    Dim i As Integer

    On Error GoTo GetFolderPath_Error
    If Left(FolderPath, 2) = "\\" Then
    FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
    If Not oFolder Is Nothing Then
    For i = 1 To UBound(FoldersArray, 1)
    Dim SubFolders As Outlook.Folders
    Set SubFolders = oFolder.Folders
    Set oFolder = SubFolders.Item(FoldersArray(i))
    If oFolder Is Nothing Then
    Set GetFolderPath = Nothing
    End If
    Next
    End If
    'Return the oFolder
    Set GetFolderPath = oFolder
    Exit Function

    GetFolderPath_Error:
    Set GetFolderPath = Nothing
    Exit Function
    End Function

    I tried changing the code to:
    If oAccount = "David IMAP" Then

    ' Get the GetFolderPath function from http://slipstick.me/getfolderpath
    Set MovePst = GetFolderPath("David IMAP\Inbox\Sent")
    Item.UnRead = False
    Item.Move MovePst
    ElseIf oAccount = "HostrupHR" Then

    ' Get the GetFolderPath function from http://slipstick.me/getfolderpath
    Set MovePst = GetFolderPath("HostrupHR\Inbox\Sent")
    Item.UnRead = False
    Item.Move MovePst
    End If

    That didn't help. I wonder if it's related to the For Each...

  11. David

    I added the .DisplayName, this didn't seem to change anything. When I use just one account, it works fine. When I add the 2nd account, it fails. I tried changing just the 2nd account's loop to item.copy instead of item.move, and it threw this error: 450: Wrong number of arguments or invalid property assignment.

    It's worth noting that this is what causes the failure:
    Condition 1:
    I send 1 message from account A. The failure ("cannot be deleted") is in the loop for account B, even though it shouldn't be affected. Notably, the message does get saved in the SENT box for BOTH account A and account B. I'm hoping this helps debug.
    Condition 2:
    I send 1 message from account B. No failure/error message, BUT the message is NOT saved in either accounts' SENT box.
    Condition 3:
    I comment out account A in the code, so this should only work for account B.
    I send 1 message from account A (nothing should happen). Message gets stored only in the sent folder for account B.
    I send 1 message from account B, no message gets stored in either SENT box.
    Condition 4:
    I comment out account B, uncomment account A.
    I send 1 message from account A, the code works properly.

    hope this helps. I'm not much of a de-bugger....

  12. Gary Wood

    Thanks for this code, Diane.

    However, I'm also having difficulty making this work correctly. I want to set it up for multiple accounts. However, once I add the first account, all mail, regardless of the Display Name of the account I send through, gets moved to the first folder path I list in the code.

    I really need to get this working, so would appreciate any suggestions/help anyone can offer.

  13. Gary Wood

    In fact, testing this further, it seems that the problem is that the If statement isn't working: the code seems to trigger a move for any sent mail -- regardless of the sending account -- to the specified folder path.

    Any ideas?

  14. Gary Wood

    Thanks, Diane.

    So, that gave me:

    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 = "NAME1" Then
    msgbox oAccount.DisplayName
    ' Get the GetFolderPath function from http://slipstick.me/getfolderpath
    Set MovePst = GetFolderPath("NAME1\Sent")
    Item.UnRead = False
    Item.Move MovePst
    End If

    If oAccount.DisplayName = "NAME2" Then

    ' Get the GetFolderPath function from http://slipstick.me/getfolderpath
    Set MovePst = GetFolderPath("NAME2\Sent Items")
    Item.UnRead = False
    Item.Move MovePst
    End If

    Next
    End Sub

    Interestingly, what happens now is that regardless of which account I send an email through, the Message Box pops up with the Display Name "Name1", and then the message gets moved to the Sent Items box listed for account "Name2"! So, the If/End doesn't seem to be working...

  15. Gary Wood

    Sorry to post again before you've had a chance to reply, Diane, but I think I know what's happening now - just not how to fix it!

    Of the two accounts I have listed in the code, I tried changing the first one to something that doesn't exist. Then, the message was moved to the Sent Items box listed for the second account.

    So, it seems that instead of the script saying "If the message was sent through "NAME1" move it to "NAME1\Sent", but continue to the next option, if it wasn't", it's actually behaving as "If an account with "NAME1" exists - and regardless of whether the message was sent through it - move the message to "NAME1\Sent".

    Does that make sense, and could it explain what's going on? If so, how can I fix it?!

    Many thanks.

  16. Gary Wood

    Outlook 2013 32-bit. Thanks for continuing to look at this for me.

  17. Gary Wood

    Hi Diane, Just wondering if you had any more thoughts on this, please? I'm in the process of switching email providers, and am keeping my fingers crossed that we can get this code to work, so I can simplify my setup!

  18. Gary Wood

    OK, no worries - I don't mean to rush you, of course. Thanks again for continuing to try and help with this.

  19. Gary Wood

    Hi Diane, I'm sorry to post again about this, but I was wondering if you've had a chance to look at the code, yet? This is the only code I can find online that comes close to what I need to do, and it would be great if we can get it working with Outlook 2013.

  20. Gary Wood

    Many thanks, Diane - this is now working perfectly. Thank you so much for your help - much appreciated.

Leave a Reply

If the Post Coment button disappears, press your Tab key.