Use a macro to move IMAP account sent items

Home / Developer / Code Samples / Use a macro to move IMAP account sent items

Last reviewed on December 4, 2014   —  32 comments

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.

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.

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

Related Posts:

  1. Mark Sent Items as Read After Copying with a Rule
  2. Messages Aren't Saved in the Sent Items Folder
  3. Use a VBA macro to monitor a folder in a secondary mailbox for new mes
    Monitor secondary mailbox folder for new messages
  4. Outlook 2013 and IMAP Sent folder

About Diane Poremsky

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 Outlook forums by Slipstick.com.

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

  1. mville
    mville December 14, 2012 at 1:08 pm | | Reply

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

    1. Diane Poremsky
      Diane Poremsky December 14, 2012 at 1:49 pm |

      Did you repeat this for each account?

      If oAccount = "second account name" Then
      Set MovePst = GetFolderPath("second-imap-account\Inbox\Sent")
      Item.UnRead = False
      Item.Move MovePst
      End If

  2. mville
    mville December 14, 2012 at 5:30 pm | | Reply

    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.

    1. Diane Poremsky
      Diane Poremsky December 14, 2012 at 8:09 pm |

      Don't use \\ on the path - also, gmail accounts shouldn't need this. Gmail saves copies in it's sent folder automatically.

  3. mville
    mville December 15, 2012 at 3:59 am | | Reply

    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.

    1. Diane Poremsky
      Diane Poremsky December 15, 2012 at 6:47 am |

      Is the first account the default account? I've been working on the premise that 'first account' was the one listed first in the code... but if it's the folder all the sent mail goes to when you don't use code, then the code isn't running. Make sure macro security is set to low and click in the Startup macro and click Run.

  4. mville
    mville December 15, 2012 at 8:05 am | | Reply

    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
    Nelson March 20, 2013 at 10:48 am | | Reply

    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

    1. Diane Poremsky
      Diane Poremsky March 20, 2013 at 11:11 am |

      You need the GetFolderPath function.

      Try this:

      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 EmailSent Items")
      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

  6. Nelson
    Nelson March 21, 2013 at 8:17 am | | Reply

    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.

    1. Diane Poremsky
      Diane Poremsky March 21, 2013 at 11:46 am |

      I'll test it. (I might regret not testing the code I gave you the other day. :) )

  7. Nils
    Nils March 31, 2013 at 12:26 am | | Reply

    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.

    1. Diane Poremsky
      Diane Poremsky March 31, 2013 at 7:35 pm |

      Do you get any error messages?

  8. Nils
    Nils April 1, 2013 at 6:15 am | | Reply

    No nothing.

  9. Nelson
    Nelson April 4, 2013 at 8:37 am | | Reply

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

  10. David
    David June 10, 2013 at 10:09 am | | Reply

    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...

    1. Diane Poremsky
      Diane Poremsky June 16, 2013 at 5:48 pm |

      This error: the items were copied instead of moved because the original items cannot be deleted. The operation failed. An object cannot be found. says there is a problem deleting the message. When you move with imap, you copy to a folder and delete it from the other folder. Try changing item.move to item.copy and see if it works.

      It looks like i have a typo in the code - you need to check the display name:
      For Each oAccount In Application.Session.Accounts

      'repeat for each account
      If oAccount.DisplayName = "account name" Then

      For multiple accounts wit would be better to assign the account name to a variable and use that in the code - provided the display name and the data file name is identical. I'll update the code to do that too.

  11. David
    David June 19, 2013 at 5:17 pm | | Reply

    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
    Gary Wood March 10, 2014 at 4:08 pm | | Reply

    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
    Gary Wood March 10, 2014 at 4:35 pm | | Reply

    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?

    1. Diane Poremsky
      Diane Poremsky March 11, 2014 at 1:00 am |

      Add msgbox oAccount.DisplayName right after the if statement and see if it pops up the expected account name.

  14. Gary Wood
    Gary Wood March 11, 2014 at 5:08 am | | Reply

    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...

    1. Diane Poremsky
      Diane Poremsky March 12, 2014 at 1:22 am |

      What version of Outlook are you using?

  15. Gary Wood
    Gary Wood March 11, 2014 at 5:21 am | | Reply

    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.

    1. Diane Poremsky
      Diane Poremsky March 11, 2014 at 8:54 am |

      That does make sense and if often the reason why If's fail. Doubling up on If's can be a problem to, but usually only if using an OR or a "not if". I'll take a look at the code and test it next.

  16. Gary Wood
    Gary Wood March 12, 2014 at 2:35 am | | Reply

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

  17. Gary Wood
    Gary Wood March 13, 2014 at 8:54 am | | Reply

    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!

    1. Diane Poremsky
      Diane Poremsky March 13, 2014 at 11:19 am |

      I'm trying to get caught up on things here and haven't had a chance to test it thoroughly yet.

  18. Gary Wood
    Gary Wood March 13, 2014 at 11:55 am | | Reply

    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
    Gary Wood March 20, 2014 at 8:29 am | | Reply

    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.

    1. Diane Poremsky
      Diane Poremsky March 27, 2014 at 2:14 am |

      I see what the problem is - the code was messed up, it's just checking the accounts, not the message.
      use this for the if -
      If Item.SendUsingAccount = "name1" Then

  20. Gary Wood
    Gary Wood March 27, 2014 at 8:52 pm | | Reply

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

Leave a Reply

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

This site uses XenWord.