Macro to automate the Move to Folder command

Last reviewed on February 12, 2014   —  12 comments

An Outlook user had a problem: delegates drafted messages for their managers and needed to save them in the manager's Drafts folder.

If the delegate creates a Draft email (not sent yet) and wants to save it in the manager's Draft folder, there is no easy way to do that. It automatically saves in the Delegate's Drafts folder by default. We tried moving it from the delegate's folder to the manager's folder, but then the manager does not have access to edit it. So we had to copy it, and then delete the copy from the Delegate's folder. This is crazy as it involved many more steps and is not efficient.

They discovered they could use the Move to Folder command to save the Drafts in the manager's Drafts folder and save a few steps. While the Move to Folder command is easy to use, especially when the folder you want to move to is on the MRU list, you can save a step or two by using a macro to move the draft.

Shared mailbox names in the folder listTo use this macro, paste it into a module in the VB Editor then change the Destination folder name. Use the mailbox or data file name as it appears in your folder list; Exchange server mailboxes will use the display name as seen in the GAL.

ribbon buttonOpen a new message form and customize the ribbon or QAT by creating a button for the macro.

Create a draft message then click the button to move it to another folder.

Move to a folder macro

Sub MoveDraftMail()
 
    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim objSourceFolder As Outlook.MAPIFolder
    Dim objDestFolder As Outlook.MAPIFolder
    Dim objItem As MailItem
     
    Set objOutlook = Application
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderDrafts)
    Set objItem = objOutlook.ActiveInspector.currentItem    
    Set objDestFolder = objNamespace.Folders("Mary Reaser").Folders("Drafts")
 
    objItem.Move objDestFolder
               
    Set objDestFolder = Nothing
End Sub

Customize the macro

You can use this macro with other Outlook item types by changing the objItem and folder names. For example, I want to save contacts in my Sharepoint list, so I changed three lines to the following:

Dim objItem As ContactItem

Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderContacts)

Set objDestFolder = objNamespace.Folders("SharePoint Lists").Folders("SPS - Contacts")

To use the currently selected folder as the source folder, use
Set objSourceFolder = objNamespace.ActiveExplorer.CurrentFolder

Dim objItem As Item Type
AppointmentItem
ContactItem
MailItem
NoteItem
TaskItem
GetDefaultFolder types
olFolderCalendar
olFolderContacts
olFolderDeletedItems
olFolderDrafts
olFolderInbox
olFolderJunk
olFolderManagedEmail (Exchange only)
olFolderNotes
olFolderOutbox
olFolderSentMail
olFolderTasks
olPublicFoldersAllPublicFolders (Exchange only)

Permissions

Please note, the user needs to have at least Create permission on the folder they are moving the item to. If the folder is in another person's mailbox, the folder (or the mailbox) needs to be open in Outlook as a shared folder or mailbox.

Give the delegate Author permission on the Drafts folder

How to use macros

First: You will need macro security set to low during testing.

To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.

After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.

Open the VBA Editor by pressing Alt+F11 on your keyboard.

To put the code in a module:

  1. Right click on Project1 and choose Insert > Module
  2. Copy and paste the macro into the new module.

More information as well as screenshots are at How to use the VBA Editor

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.

12 responses to “Macro to automate the Move to Folder command”

  1. Ernesto

    I changed the code to copy emails to task folder and I am getting a 91 error on line
    Set objItem = objOutlook.ActiveInspector.CurrentItem

    Thte new code is
    Sub CopyToTask()
    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim objSourceFolder As Outlook.MAPIFolder
    Dim objDestFolder As Outlook.MAPIFolder
    Dim objItem As MailItem
    Set objOutlook = Application
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
    Set objItem = objOutlook.ActiveInspector.CurrentItem
    Set objDestFolder = objNamespace.GetDefaultFolder(olFolderTasks)
    objItem.Copy objDestFolder
    Set objDestFolder = Nothing
    End Sub

    1. Diane Poremsky

      .ActiveInspector.CurrentItem works with open items, not selected items. See http://www.slipstick.com/developer/outlook-vba-work-with-open-item-or-select-item/ - you can use .ActiveExplorer.Selection.Item(1) for open items or the GetCurrentItem function for either.

      However, this is erroring on the copy - you are trying to copy a mail item to tasks. You need to use Move instead. Yeah, doesn't make much sense, but it works. :)

  2. Douglas

    I'm hoping someone can help me. I'm trying to make a script that will take mail thats in the inbox and if it is after 60 days move it to my 7 Year Retention folder under Managed Folders in outlook. I have been able to get it to work if i want to move it to another folder under my inbox but not outside of the inbox... Please help.

    Private Sub Application_Startup()

    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim objSourceFolder As Outlook.MAPIFolder
    Dim objDestFolder As Outlook.MAPIFolder
    Dim objVariant As Variant
    Dim lngMovedItems As Long
    Dim intCount As Integer
    Dim intDateDiff As Integer
    Dim strDestFolder As String

    Set objOutlook = Application
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)

    ' use a subfolder under Inbox
    Set objDestFolder = objSourceFolder.Folders("@test")

    For intCount = objSourceFolder.Items.Count To 1 Step -1
    Set objVariant = objSourceFolder.Items.Item(intCount)
    DoEvents
    If objVariant.Class = olMail Then

    intDateDiff = DateDiff("d", objVariant.SentOn, Now)

    ' I'm using 7 days, adjust as needed.
    If intDateDiff > 60 Then

    objVariant.Move objDestFolder

    'count the # of items moved
    lngMovedItems = lngMovedItems + 1

    End If
    End If
    Next

    ' Display the number of items that were moved.
    MsgBox "Moved " & lngMovedItems & " messages(s)."
    Set objDestFolder = Nothing

    End Sub

    1. Diane Poremsky

      Is it in the same mailbox as your inbox or in a different data file? If Managed Folders is at the same level as your inbox, use this:
      Set objDestFolder = Session.GetDefaultFolder(olFolderInbox).Parent._
      Folders("Managed Folders")

      For a folder under managed folders, you'd add .Folders("Subfolder") under it. If you need to go too far down you should walk down the folders to avoid long strings with a lot of dots.
      Set objParent = Session.GetDefaultFolder(olFolderInbox)
      Set objManaged = objParent.Parent.Folders("Managed Folders")
      Set objDestFolder = objManaged.Folders("SubFolder")

  3. Douglas

    Set objDestFolder = Session.GetDefaultFolder(olFolderInbox).Parent._
    Folders("Managed Folders").Folders("7 Year Retention")

    would take the mail from inbox and place it in the managed folder > 7 year retention folder correct ?

    And I would replace
    Set objDestFolder = objSourceFolder.Folders("@test")
    With the above code to make it work?

    1. Diane Poremsky

      I know you've already figured it, but for the benefit of others...

      Correct, you need to replace the original objDestFolder object with one representing the new path. While it will work to put the entire path into one object, it's better to assign each folder to an object and split the path - VBA doesn't like a lot of dots in the object.

  4. Douglas

    This Worked! Thank you for your help!!!

    Private Sub Application_Startup()
    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim objSourceFolder As Outlook.MAPIFolder
    Dim objDestFolder As Outlook.MAPIFolder
    Dim objVariant As Variant
    Dim lngMovedItems As Long
    Dim intCount As Integer
    Dim intDateDiff As Integer
    Dim strDestFolder As String

    Set objOutlook = Application
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)

    ' use a subfolder under Inbox
    Set objParent = Session.GetDefaultFolder(olFolderInbox)
    Set objManaged = objParent.Parent.Folders("Managed Folders")
    Set objDestFolder = objManaged.Folders("7 Year Retention")

    For intCount = objSourceFolder.Items.Count To 1 Step -1
    Set objVariant = objSourceFolder.Items.Item(intCount)
    DoEvents
    If objVariant.Class = olMail Then

    intDateDiff = DateDiff("d", objVariant.SentOn, Now)

    ' I'm using 7 days, adjust as needed.
    If intDateDiff > 7 Then

    objVariant.Move objDestFolder

    'count the # of items moved
    lngMovedItems = lngMovedItems + 1

    End If
    End If
    Next

    ' Display the number of items that were moved.
    MsgBox "Moved " & lngMovedItems & " messages(s)."
    Set objDestFolder = Nothing

    End Sub

  5. shiv

    Hi, can you plz help.

    the for atmt is running only 3 time and exits,

    1. Diane Poremsky

      What macro are you using?

  6. chrisbr40

    I'm an Outlook 2013 user but spend a fare amount of time with Outlook for Mac for one and only one feature; Message\Move\Choose Folder and its shortcut key. My work requires me to use hundreds of Outlook folder. The time saved by being able to select a message in the Inbox, hit Shift-Command-M, and start typing the folder name is immense.

    Is there way to replicate this function in Outlook 2013?

    1. Diane Poremsky

      Outlook 2013's shortcut is Ctrl+Shift+V - you can only type the first letter of a folder to jump to it, not the folder name. Plus, you could use Quick Steps to move messages.

  7. AceoStar

    Here is my solution, it's not pretty but it works :)

    Sub PurgeErrorMail()

    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim objSourceFolder As Outlook.MAPIFolder
    Dim objDestFolder As Outlook.MAPIFolder
    Dim objItem As MailItem

    Set objOutlook = Application
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox).Folders("Errors")
    Set objDestFolder = objNamespace.GetDefaultFolder(olFolderDeletedItems)

    ' Delete messages from top folder (Errors in this case)
    For intCount = objSourceFolder.Items.Count To 1 Step -1
    Set objVariant = objSourceFolder.Items.Item(intCount)
    DoEvents
    If objVariant.Class = olMail Then
    objVariant.Move objDestFolder
    lngMovedItems = lngMovedItems + 1
    End If
    Next

    ' Iterate through the Errpr subfolder
    For intCount = objSourceFolder.Folders.Count To 1 Step -1
    Set subFolder = objSourceFolder.Folders.Item(intCount)
    DoEvents
    If subFolder.Class = olFolder Then
    For mailCount = subFolder.Items.Count To 1 Step -1
    Set subfolderMail = subFolder.Items.Item(mailCount)
    DoEvents
    If subfolderMail.Class = olMail Then
    subfolderMail.Move objDestFolder
    lngMovedItems = lngMovedItems + 1
    End If
    Next
    End If
    Next

    If lngMovedItems > 0 Then
    MsgBox "Moved " & lngMovedItems & " messages(s)."
    Else: MsgBox "Nothing to move"
    End If
    Set objDestFolder = Nothing
    End Sub

Leave a Reply

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

This site uses XenWord.