Outlook Macros to Categorize and Archive Messages

Wed, 10 Apr 2013 12:22:39 +0000

If you’re still rockin’ Outlook 2007 and want to create some macros to categorize or archive your email, here’s some copy and paste code to have fun with…

Sub Archive()
 Call CommonCategorizeAndArchive(True, False, False)
End Sub

Sub Categorize()
 Call CommonCategorizeAndArchive(False, True, False)
End Sub

Sub CategorizeAndArchive()
 Call CommonCategorizeAndArchive(True, True, False)
End Sub

Sub Task()
 Call CommonCategorizeAndArchive(True, True, True)
End Sub

Private Sub CommonCategorizeAndArchive(archiveEm As Boolean, categorizeEm As Boolean, taskIt As Boolean)
 Dim olApp As New Outlook.Application
 Dim olItem As Object
 Dim olExp As Outlook.Explorer
 Dim olSel As Outlook.Selection
 Dim olArchive As Outlook.Folder
 Dim olTasks As Outlook.Folder
 Dim olNameSpace As Outlook.NameSpace
 Dim olTmpMailItem As Outlook.MailItem
 
 Set olExp = olApp.ActiveExplorer
 Set olSel = olExp.Selection
 Set olNameSpace = olApp.GetNamespace("MAPI")
 
 Set olArchive = olNameSpace.GetDefaultFolder(olFolderInbox).Folders("@Archive")
 Set olTasks = olNameSpace.GetDefaultFolder(olFolderInbox).Folders("zTasks")

 For intItem = 1 To olSel.Count
 Set olItem = olSel.Item(intItem)
 olItem.UnRead = False
 
 If (categorizeEm = True) Then
 olItem.ShowCategoriesDialog
 End If
 
 If (archiveEm = True) Then
 olItem.Move olArchive
 End If
 
 If (taskIt = True) Then
 Set olTmpMailItem = olItem.Copy
 olTmpMailItem.Move olTasks
 End If
 Next intItem
End Sub

VBA on MarkJacobsen.net

Outlook Macros to Categorize and Archive Messages