Macro to automate the Move to Folder command

Last reviewed on February 12, 2014   —  7 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

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.

7 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

  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

  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?

  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

Leave a Reply

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