Outlook Macros to Categorize and Archive Messages

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

Leave a Reply