Outlook Macro to Move an Email to Folder
When I took on my new job recently (about 3 months ago), I had no idea how much email I would be getting. Needless to say… keeping my head above the “email water” has been consuming every free moment I have. Be it on the airplane or during the weekend when the misses is still asleep.
The good news is… I’m getting better and have put together a (debatably) decent email management system. The center of it is moving an email from my inbox to subfolders with marcos and shortcut keys.
Here is a copy of the macro I put together that’ll move the selected email item to a sub-folder. For each subfolder you want to move to… you need to create another macro. After you have tested the macro… add it to the tool bar and mark it with a shortcut key. Then, you can simply keyboard your way through your emails moving them one by one to a “for action” folder or “for review” folder.
Sub MoveSelectedMessagesToFolder()
On Error Resume Next
Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objFolder = objInbox.Folders("_Reviewed")
'Assume this is a mail folder
If objFolder Is Nothing Then
MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
End If
If Application.ActiveExplorer.Selection.Count = 0 Then
'Require that this procedure be called only when a message is selected
Exit Sub
End If
For Each objItem In Application.ActiveExplorer.Selection
If objFolder.DefaultItemType = olMailItem Then
If objItem.Class = olMail Then
objItem.Move objFolder
End If
End If
Next
Set objItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub