When my work PC came off lease I took the necessary steps to back up my documents, IE favorites, etc. so I could add them on the new machine. After getting the new machine (and turning in the old one), it didn’t take me long to realize I had forgotten to copy something I use A LOT – Outlook macros. Unfortunately, I didn’t make notes when I set them up several years ago, so I had to start from scratch. There were plenty of examples on the web, but each assumed the target folder was located under the Inbox folder. My target folders were located on the same level as the Inbox. I finally got it working and decided to document the process for future reference.
The premise behind these macros is based on David Allen’s “Getting Things Done” methodology (GTD). I was also influenced by the “Inbox Zero” series on Merlin Mann’s “43 Folders” website, and a very good 2008 MacWorld article series entitled “Empty Your Inbox.”
While my email inbox never really gets to ‘zero,’ I am able to keep it pretty lean – depending on how diligent I am in following the GTD system.
Step 1 – Create your target folders
To create folders, right-click where you want to the folders to be created and select “New Folder” from the pop-up menu. I created my folders under the main Mailbox home folder. If you want to have your folders sort to the top of the list, start the folder name with a symbol such as ‘@’.
I use 4 main folders:
- @Action – Items I need to take action on to complete
- @Filed – Items I want to keep for future reference (i.e., I don’t want to delete it)
- @Someday – Items I may want to take action on at some point in the future; no time constraint
- @Waiting – Items I’m waiting on a response from someone else before I can resolve
Step 2 – Create your Outlook Macros
In Outlook (2007), click on the Tools | Macro menu item and select Visual Basic Editor (or use the Alt+F11 shortcut). Copy/paste the following VB Macro into the script editor. Make sure to change the name of the folders to match your email setting.
'Outlook VB Macro to move selected mail item(s) to a target folder
Sub MoveToFiled()
On Error Resume Next
Dim ns As Outlook.NameSpace
Dim moveToFolder As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem
Set ns = Application.GetNamespace("MAPI")
'Define path to the target folder
Set moveToFolder = ns.Folders("Mailbox - Jim Merrell").Folders("@Filed")
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("No item selected")
Exit Sub
End If
If moveToFolder Is Nothing Then
MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error"
End If
For Each objItem In Application.ActiveExplorer.Selection
If moveToFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.move moveToFolder
End If
End If
Next
Set objItem = Nothing
Set moveToFolder = Nothing
Set ns = Nothing
End Sub
Here is how it looks in the VB Editor:
Step 3 – Test macros
To test the macros, click Run on the menu, the green ‘play’ button, or press F5 (Run Macro) in the VB Editor window. If no errors are displayed, verify that the selected email(s) has moved to the desired target folder.
Update 5/25/2011: If nothing seems to happen when you run the macro (i.e., no error message and the email isn’t moving to the target folder), the security settings on the machine may be blocking the macros from running. See the following post for more information.
Step 4 – Repeat
Repeat steps 2 and 3 above to create a separate macro for each of your target folders. For simplicity, I added all the macros to the default module (module1); copy/paste each function/macro after the “End Sub” line of the previous macro. After you copy/paste the code remember to:
- Update the function/method name of the script to describe what the macro does (i.e., Sub MoveToFiled(), Sub MovedToAction(), etc.)
- Update the path to your target folder
- Save the macro/script file
Update 5/25/2011: A ‘cleaner’ way to avoid all the duplication of code – the only difference is the name of the target folder – is to have a main function that does all the work and then call that function passing in the name of the target folder. Example:
'Outlook VB Macro to move selected mail item(s) to a target folder
Sub MoveToFolder(targetFolder)
On Error Resume Next
Dim ns As Outlook.NameSpace
Dim MoveToFolder As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem
Set ns = Application.GetNamespace("MAPI")
'define path to the target folder; the following assumes the target folder
'is a sub-folder of the main Mailbox folder
Set MoveToFolder = ns.Folders("Mailbox - Jim Merrell").Folders(targetFolder)
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("No item selected")
Exit Sub
End If
If MoveToFolder Is Nothing Then
MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error"
End If
For Each objItem In Application.ActiveExplorer.Selection
If MoveToFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.move MoveToFolder
End If
End If
Next
Set objItem = Nothing
Set MoveToFolder = Nothing
Set ns = Nothing
End Sub
Sub MoveToFiled()
MoveToFolder ("@Filed")
End Sub
Sub MoveToAction()
MoveToFolder ("@Action")
End Sub
Sub MoveToWaiting()
MoveToFolder ("@Waiting")
End Sub
Step 5 – Add button to Outlook menu bar
To run the macro using the click of the mouse, or using hot keys, I added the macros to the menu bar. Right-click on a toolbar and select ‘Customize…’ from the pop-up menu
On the Commands tab of the Customize window, scroll down the Categories list and select Macros. You should see the macros (created in step 2 above) in the Commands section.
To add a macro to the toolbar, left-click and drag the macro command(s) to the toolbar and release in the desired location.
With the Customize window still displayed, right-click on the macro item in the toolbar to display additional customization options. To enable the macro to run using a keyboard shortcut, use the ‘&’ character before the desired character (used in conjunction with the Alt key) in the Name. For example, to run the “MoveToFiled” macro with the Alt+1 shortcut, change the name to “&1.MoveToFiled.” (Note the ‘.’ is just to provide a visual separation.) Also, to save space on the toolbar, select “Text Only (Always).”
The finished result looks like this:
Now you can run your macro by clicking on the toolbar item, or using the Alt+1, Alt+2, or Alt+3 shortcut.
Next: Adding Macros to Outlook’s Quick Access Toolbar
Have a great day!
When I run this I get the “Target folder not found” error.” I changed your code for folders to:
Set moveToFolder = ns.Folders(“Mailbox – Solution Center\Inbox”).Folders(“*Assigned Tickets”)
The “*Assigned Tickets” folder is a sub-folder in our Inbox folder. Can you see what I’m doing wrong?
Hi Dave,
If your target folder is a sub-folder in your Inbox, you will need to add an additional “.Folders” call to get there:
Set moveToFolder = ns.Folders("Mailbox - Solution Center").Folders("Inbox").Folders("*Assigned Tickets")Or, better, you can use the predefined “GetDefaultFolder” function to get straight to the Inbox level
Set moveToFolder = ns.GetDefaultFolder(olFolderInbox).Folders("*Assigned Tickets")Regards,
Jim
hi Jim,
even after i tried with the reply which you have given above still am getting that target folder not found.
were both my inbox as well as my atrget folder Assigned both are saperate folders.
Set moveToFolder = ns.Folders(“Mailbox – Muthyala, Pratik\Inbox”).Folders(“Assigned”)
Hi Pratik, It’s hard to say without seeing your folder hierarchy. However, assuming “Assigned” is a folder located within the main Inbox folder (i.e., a child of the folder actually called “Inbox”), I suggest using the following approach to set your folder path:
Set moveToFolder = ns.GetDefaultFolder(olFolderInbox).Folders("Assigned")
I hope that helps.
Regards,
Jim
In general, is there a way to pass a multi-level folder hierarchy to the Folders method? It seems like I have to repeat the call to Folders for each folder and if I need to drill down 3 or 4 levels, it is tedious.
I don’t want to use GetDefaultFolder because I’m not pointing to a folder on Inbox.
Here is what I want
Set MoveToFolder = ns.Folders(“Mailbox – John\folder name1\folder name2″)
Not
Set MoveToFolder = ns.Folders(“Mailbox – John).Folders(“folder name1″).Folders(“folder name2″)
Yes, but it takes some additional coding. Here is an example taken from the Microsoft Developer site using Office 2007 (should work same with newer versions):
Function GetFolder(ByVal FolderPath As String) As Outlook.Folder
Dim TestFolder As Outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer
On Error GoTo GetFolder_Error
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array
FoldersArray = Split(FolderPath, "\")
Set TestFolder = Application.Session.Folders.item(FoldersArray(0))
If Not TestFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = TestFolder.Folders
Set TestFolder = SubFolders.item(FoldersArray(i))
If TestFolder Is Nothing Then
Set GetFolder = Nothing
End If
Next
End If
'Return the TestFolder
Set GetFolder = TestFolder
Exit Function
GetFolder_Error:
Set GetFolder = Nothing
Exit Function
End Function
Sub TestGetFolder()
Dim folder As Outlook.Folder
Set folder = GetFolder ("\\Mailbox - Dan Wilson\Inbox\Customers")
If Not(folder Is Nothing) Then
folder.Display
End If
End Sub
To summarize, “if you provide the folder path “Mailbox – Dan Wilson\Inbox\Customers”, the code in the TestGetFolder procedure will display the Folder object that corresponds to the Customers folder under Dan Wilson’s Inbox, if the Customers folder exists under the Inbox. If the Customers folder does not exist, GetFolder will return Nothing.“
Hi Jim,
Have you come across any evidence as to whether this works in Outlook 2010? Also, do you see any benefit in actually using 43 folders in your email hierarchy, in addition to what you’ve already implemented?
Daniel, I don’t have Outlook 2010 yet so I can’t say for certain. But, I think it should work since the macro isn’t doing anything fancy.
My take on the “43 Folders” system is that it’s geared more towards keeping track of all your “to do” items. Specifically folder 1 – 31 represent each day of the month, then another 12 folders for Jan – Dec. You file things based on when the item is due. Personally I didn’t see any benefit based on the problem I was trying to solve – cleaning up my inbox. In my case, if I get a “to do” email, I just put it in the ‘action’ folder. After that, I simply file it or delete it.
I also think it might get a bit confusing using 43 ‘electronic’ folders.
Regards,
Jim
Came here looking for account transfers from outlook to Gmail, although I learned a lot about folder macros. Pretty cool! In case you want to transfer between email accounts I also found movemyemail.com to be pretty good, it’s not free though and I’m really looking for a Gmail solution. Thanks again.
This is a great tip for pre 2010 version of Outlook but I recommend Quick Steps to make this obslete. VBA is a great skill to have but Microsoft has done a great job improving their rules system.
Below is a link to a blog post I did on this exact topic.
http://marc.rohde-net.us/blog/2010/07/04/how-i-used-outlook-2010-quick-steps-to-eliminate-custom-macros/
Thanks Marc. I hope to be getting Office 2010 soon and will definitely look into this feature. Sounds interesting.
Hi Jim,
Could you help me about the Outlook 2010.
My question is How to move the Email in particular Folders when i set the time.
Can i set the time..?
E.g: When i received Email of Mr. Larry in my Inbox after one month it will automatically moved in My sub folder of Mr. Larry.
I Hope you understand my query on this regard.
If you want any query please write us on my email don.manan@gmail.com
Thanks in advance.
Manan,
There has to be something (an event) to trigger the macro. One option might be to create a script that would move all mail items in your inbox with ‘ReceivedTime’ <= the current date. Then you could manually trigger/run the macro (once a day, once a week, etc.) and it would move all mail items that met the criteria.
Jim
Hi Jim,
I am very grateful to you for sharing this bit of information.
Can you guide me for the code correction to achieve following.
I have rules in place to move all mails coming from a particular account into respective folders.
I have created sub-folders in that folder where I want to move these mails afterwards based on their subject.
I can set up rules for these too, but it appears my rules are already too much for outlook to handle.
Beside Outlook provides rule wherein you can do following:
From : xyz@abc.com
AND Subject:”abc”
But it cannot provide following:
From : xyz@abc.com
OR Subject:”abc” or “pqr” or “rst”
So I will need something as
---------------------------------------------------------------------
Set moveFromFolder = ns.GetDefaultFolder(olFolderInbox).Folders("FromAssigned")
Set moveToFolder = ns.GetDefaultFolder(olFolderInbox).Folders("ToAssigned")
For Each objItem In Application.ActiveExplorer.Selection
If MoveToFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
If objItem.Subject = “abc” or objItem.Subject = “pqr” Then
---------------------------------------------------------------------
Regards
Sundar Singh
This code works great but I can’t seem to get the syntax right for sub folders. If I have a folder called “Archive” inside my Inbox how would I code the folder name in the sub?
I have tried all of the following:
Inbox\Archive
\inbox\Archive
\\inbox\Archive
/inbox/Archive
//inbox/Archive
I managed to figure this out. To access a sub folder set the path as in Inbox\Archive and then use this code:
If InStr(targetFolder, “\”) > 0 Then
fArray = Split(targetFolder, “\”)
Set MoveToFolder = ns.Folders(“Mailbox-Mark.MacLachlan”).Folders(fArray(0))
X = 1
Do Until X = UBound(fArray) + 1
Set MoveToFolder = MoveToFolder.Folders(fArray(X))
X = X + 1
Loop
Else
Set MoveToFolder = ns.Folders(“Mailbox-Mark.MacLachlan”).Folders(targetFolder)
End If
Hi Mark, If the “Archive” folder is a subfolder located under the main “Inbox” folder, see if the following work:
Set moveToFolder = ns.GetDefaultFolder(olFolderInbox).Folders("Archive")
The
GetDefaultFolder(olFolderInbox)function takes you right into the main “Inbox” folder, and the.Folders("Archive")will put you in the Archive folder that’s located in the Inbox folder.Regards,
Jim
Dear Marc, could you possibly post once again the entire script with this subfolder-Routine included? Not getting this to work and it would be VERY helpful!
Regards,
David
MovetoAction works but the other macros fails with the below error message:
Compile error:
Wrong number of arguments or invalid property assignment
I found the solution:
Sub MoveToWaiting()
MoveToWaiting (“@Waiting”)
End Sub
MoveToWaiting should be changed to MoveToFolder
I’ve updated the post accordingly.
This is awesome, thank you! Can you tell me how I can get this working with multiple mailboxes? I specified my primary mailbox at “Set moveToFolder = ns.Folders” and everything works great, but I would also like to be able to move email messages to folders within other accounts.
I have used the cleaner way from the update 5/25/2011
Cheers
Hi Jim,
The above example is good. But if we want to move an attachment which is contains a email attachment into another folder, what can be done?
Thanks
Sarves
Hi Jim… I write from Caracas (Venezuela), excuse my english… I need to move all mail in “sent” folder to another folder that I create. How I can do…???. I need that this process happen every 6 hours. I use 3 different email accounts on my Outlook-07 and one of those is used by many people for this reason I need to move from time to time the emails that are sent through the account because the mailbox is full. Thank you…Best regards…
Thank you so much for posting this! My carpal tunneled wrists thank you. Being right-handed I’ve been meaning to set up a hot key macro for sometime to avoid the mouse drags from right-to-left that I do repeatedly throughout the day. I get way too many emails…
Thanks a lot for these examples.
Hi Jim,
Thanks for posting up the information, I have implemented this for a few tasks but one of them I am having trouble with.
I would like to move an email from the inbox to the archive folder. The catch seems to be because I am using google apps sync and the archived folder is the equivilant to the archive function in gmail (removing all tags from an email).
When I run the code I do not get any response. I have done quite a bit of searching for a solution but cannot come up with anything.
cheers
Brad
‘Move selected mail item(s) to Archived Folder
Sub MoveToArchived1()
On Error Resume Next
Dim ns As Outlook.NameSpace
Dim moveToFolder As Outlook.MAPIFolder
Dim objItem As Outlook.MailItem
Set ns = Application.GetNamespace(“MAPI”)
‘Define path to the target folder
Set moveToFolder = ns.Folders(“Google Apps – brad.maxwell@ahi-carrier.com.au“).Folders(“[Archived]“)
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox (“No item selected”)
Exit Sub
End If
If moveToFolder Is Nothing Then
MsgBox “Target folder not found!”, vbOKOnly + vbExclamation, “Move Macro Error”
End If
For Each objItem In Application.ActiveExplorer.Selection
If moveToFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.Move moveToFolder
End If
End If
Next
Set objItem = Nothing
Set moveToFolder = Nothing
Set ns = Nothing
End Sub
Brad, did you come up with a solution for this? I’m having the same problem. Many thanks.
Dear Jim,
I stumbled accross your page, looking for a solution to my problem.
I do not have the knowledge on the topic (macros for outlook) like you do.
I have managed to get a script that gives me the e-mail addresses of all the recipients I’ve emailed did not received my email.
The script works well but what I need but cannot put together is a secondary part within the script that deletes (or moves to a specific folder) these “your message was not delivered” automatic emails from outlook that I get for every not delivered email.
I am copying the script and I really hope to get an email response from you.
Your help could really cheer me up man.
Thanking you in advance…
___________________________________________________________
Sub Extract_Invalid_To_Excel()
Dim olApp As Outlook.Application
Dim olExp As Outlook.Explorer
Dim olFolder As Outlook.MAPIFolder
Dim obj As Object
Dim stremBody As String
Dim stremSubject As String
Dim i As Long
Dim x As Long
Dim count As Long
Dim RegEx As Object
Set RegEx = CreateObject(“VBScript.RegExp”)
Dim xlApp As Object ‘Excel.Application
Dim xlwkbk As Object ‘Excel.Workbook
Dim xlwksht As Object ‘Excel.Worksheet
Dim xlRng As Object ‘Excel.Range
Set olApp = Outlook.Application
Set olExp = olApp.ActiveExplorer
Set olFolder = olExp.CurrentFolder
‘Open Excel
Set xlApp = GetExcelApp
xlApp.Visible = True
If xlApp Is Nothing Then GoTo ExitProc
Set xlwkbk = xlApp.Workbooks.Add
Set xlwksht = xlwkbk.Sheets(1)
Set xlRng = xlwksht.Range(“A1″)
xlRng.Value = “Bounced email addresses”
‘Set count of email objects
count = olFolder.Items.count
‘counter for excel sheet
i = 0
‘counter for emails
x = 1
For Each obj In olFolder.Items
xlApp.StatusBar = x & ” of ” & count & ” emails completed”
stremBody = obj.Body
stremSubject = obj.Subject
‘Check for keywords in email before extracting address
If checkEmail(stremBody) = True Then
‘MsgBox (“finding email: ” & stremBody)
RegEx.Pattern = “\b[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,4}\b”
RegEx.IgnoreCase = True
RegEx.MultiLine = False
Set olMatches = RegEx.Execute(stremBody)
For Each match In olMatches
xlwksht.Cells(i + 2, 1).Value = match
i = i + 1
Next match
‘TODO move or mark the email that had the address extracted
Else
‘To view the items that aren’t being parsed uncomment the following line
‘MsgBox (stremBody)
End If
x = x + 1
Next obj
xlApp.ScreenUpdating = True
MsgBox (“Invalid Email addresses are done being extracted”)
ExitProc:
Set xlRng = Nothing
Set xlwksht = Nothing
Set xlwkbk = Nothing
Set xlApp = Nothing
Set emItm = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing
End Sub
Function GetExcelApp() As Object
‘ always create new instance
On Error Resume Next
Set GetExcelApp = CreateObject(“Excel.Application”)
On Error GoTo 0
End Function
Function checkEmail(ByVal Body As String) As Boolean
Dim keywords(54) As String
keywords(0) = “Delivery to the following recipients failed”
keywords(1) = “user unknown”
keywords(2) = “The e-mail account does not exist”
keywords(3) = “undeliverable address”
keywords(4) = “550 Host unknown”
keywords(5) = “No such user”
keywords(6) = “Addressee unknown”
keywords(7) = “Mailaddress is administratively disabled”
keywords(8) = “unknown or invalid”
keywords(9) = “Recipient address rejected”
keywords(10) = “disabled or discontinued”
keywords(11) = “Recipient verification failed”
keywords(12) = “no mailbox here by that name”
keywords(13) = “This user doesn’t have a yahoo.com account”
keywords(14) = “No mailbox found”
keywords(15) = “Domain name not found”
keywords(16) = “mailbox unavailable”
keywords(17) = “Mailbox disabled”
keywords(18) = “mailbox is inactive”
keywords(19) = “address error”
keywords(20) = “unknown recipient”
keywords(21) = “unknown user”
keywords(22) = “mail to the recipient is not accepted on this system”
keywords(23) = “no user with that name”
keywords(24) = “invalid recipient”
keywords(25) = “Domain name not found”
keywords(26) = “DNS Error”
keywords(27) = “Delivery to the following recipient has been delayed”
keywords(28) = “Delivery to the following recipient failed permanently”
keywords(29) = “This is an automatically generated Delivery Status Notification”
keywords(30) = “The error that the other server returned was”
keywords(31) = “This message was created automatically by mail delivery software”
keywords(32) = “mailbox is full”
keywords(33) = “out of the office”
keywords(34) = “Could not be delivered because of”
keywords(35) = “The e-mail address you entered couldn’t be found”
keywords(36) = “The recipient’s e-mail address was not found”
keywords(37) = “An error occurred while trying to deliver this message”
keywords(38) = “Your message can’t be delivered because delivery to this address is restricted”
keywords(39) = “This is a permanent error; I’ve given up. Sorry it didn’t work out”
keywords(40) = “A message that you sent could not be delivered to one or more of its recipients”
keywords(41) = “I’m sorry to have to inform you that your message could not be delivered to one or more recipients”
keywords(42) = “You are not allowed to post to this mailing list, and your message has been automatically rejected”
keywords(43) = “The recipient’s mailbox is full and can’t accept messages now”
keywords(44) = “Failed to deliver to”
keywords(45) = “A problem occurred during the delivery of this message to this e-mail address”
keywords(46) = “The following addresses had permanent fatal errors”
keywords(47) = “5.3.0″
keywords(48) = “5.4.6″
keywords(49) = “Mailbox quota exceeded”
keywords(50) = “The message you sent requires that you verify that you are a real live human being and not a spam source”
keywords(51) = “I AM CURRENTLY ON ANNUAL LEAVE”
keywords(52) = “out of the office”
keywords(53) = “e-mail address has changed”
keywords(54) = “Technical details of permanent failure”
‘Default value
checkEmail = False
For Each word In keywords
If InStr(1, Body, word, vbTextCompare) > 1 Then
checkEmail = True
Exit For
End If
Next word
End Function
Pingback: Getting Things Done… ala Micheal Linenberger | Personal. Learning. Reflections.
Hi,
In outlook there are two ways to move a message – with keyboard shortcut (ctrl shift v) and with the mouse (move to folder option).
The second option shows a cache of several last folder that I moved emails to.
How can I make a macro to combine between those two options?
E.g. Press a combination of keys and get the last folders I moved emails to + the option to browse and select a folder?
Thanks
Yossi
Appreciate this is quite old now but I’m having an issue using your code to move an email to a public folder and was wondering if you could help.
The code works fine moving an email from a Public Folder to my personal inbox but not from my inbox to a Public folder. I think I’m just getting the syntax wrong but maybe it’s something more technical?
In the Outlook folder tree this is the path
Public Folders>All Public Folders>Suspect Email>Submitted
I changed you code to below but it says “target not found”
Set moveToFolder = ns.Folders("Public Folders").Folders("All Public Folders").Folders("Suspect Email").Folders("Submitted")Thom, what version of Outlook are you using? We just upgraded to 2010, and as Marc mentioned above, I found that I was able to replace all my Outlook home grown VB scripts described here using the built-in Quick Steps feature.
It sounds like there must be something wrong with the path to your folder. One thing you might try is to use the built in default folder constant for the “Public Folders – All Public Folders” folder. Example:
Set moveToFolder = ns.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("Suspect Email").Folders("Submitted")Jim
I got this code to work for me. Is there a way to add to the code so that it will also move the message and mark it as read, at the same time?
Yes. I haven’t tested this, but try adding the following line to the section in the script that is moving the email to the folder:
...
objItem.UnRead = False
objItem.move MoveToFolder
...