Outlook macros for processing e-mail

I don't write many Outlook macros primarily because I don't have time to learn the CDO document model.  But once upon a time I wrote a couple of macros that have become invaluable to me ever since. 

Some background.  I process my e-mail roughly like this:

1. I use Outlook rules to filter out e-mail that is sent to most of the e-mail lists that I subscribe and put it into folders under Inbox. 
2. RSS feeds go under the RSS Feeds folder using the built-in Outlook 2007/Internet Explorer feed engine.  That used to require all sorts of third-party software, like NewsGator etc..
3. What's left in the Inbox I try to filter as follows:
   (i) Stuff I want to blog about or useful information that I want to save.  Create a Live Writer page and save a local draft.
   (ii) Stuff I have to do something about.  This is the tough stuff that usually ends up stuck in your Inbox for weeks.  It's things like write an e-mail, review something, make a phone call.  Somehow this has to make it's way onto a to-do list.
   (iii) Stuff that I processed, and I don't need anymore.  Delete it.
   (iv) Stuff that is processed, but contains useful information that I might need again with 6 months.  Archive it.
   (v) Stuff that is definitely going to be useful.  Use the handy dandy "Send to OneNote" feature of Office 2007 and file the whole e-mail away.

Those are basically the rules that I follow.  The two that are tricky are the short term archive 3(iv) and the to-do items 3(ii).  And these are what the macros are for.

The macros are given at the end of this entry.  A quick note on how to "install" them on your system.  It's all about security.  Use the following steps:

1. Open up Tools > Macro > Visual Basic Editor.  Paste in the macros in a project (either a new one or the existing default one).
2. Go to the Start menu, and then Microsoft Office > Microsoft Office Tools > Digital Certificate for VBA Projects.  Run it and create a digital certificate for your local machine.  I usually give my name.
3. Go back to the macro editor and select Tools > Digital Signature and Choose your newly minted signature.
4. Go to Outlook and select Tools > Macro > Security and select "Warnings for signed macros; unsigned macros are disabled" in Trust Center.
5. Now you're ready to run your macros.  I usually create a toolbar and add buttons for the two macros MoveToArchive and CreateTaskAndMoveToArchive.

When I've read an e-mail and decided that it's worth saving, I hit the MoveToArchive button.  If it's something that I need to do something about it's the CreateTaskAndMoveToArchive button.  The latter copies the body of the e-mail into the task so I have some context about what it was.

My Archive folder has an Auto Archive setting (go to the Properties dialog) that permanently deletes stuff older than 6 months, as do all my folders except the Inbox. 

Lastly, the To-Do bar is a really good way to track tasks in Outlook.  You should check it out.

Option Explicit
 
Sub MoveToArchive()
    Dim objApp As Outlook.Application
    Dim objFolder As Outlook.MAPIFolder
    Dim objItem As Object
       
    Set objApp = Outlook.Application
    Set objFolder = GetFolder("Mailbox - John Lyon-Smith\Archive")
       
    If (objFolder Is Nothing) Then
        MsgBox "Cannot find Mailbox\Archive archive folder", vbOKOnly Or vbError, "Move to Archive Folder"
    Else
        If (Not objApp.ActiveExplorer Is Nothing) Then
            For Each objItem In objApp.ActiveExplorer.Selection
                If (Not objItem Is Nothing And TypeName(objItem) = "MailItem") Then
                    objItem.Move objFolder
                End If
            Next
        End If
    
        Set objFolder = Nothing
    End If
       
    Set objItem = Nothing
    Set objApp = Nothing
End Sub
 
Sub CreateTaskAndMoveToArchive()
    Dim objApp As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim objTasksFolder As Outlook.MAPIFolder
    Dim objTaskItem As Outlook.TaskItem
    Dim objItem As Object
    Dim objMailItem As Outlook.MailItem
    
    Set objApp = Outlook.Application
    Set objNamespace = objApp.GetNamespace("MAPI")
    Set objTasksFolder = objNamespace.GetDefaultFolder(olFolderTasks)
    
    If (Not objApp.ActiveExplorer Is Nothing) Then
        For Each objItem In objApp.ActiveExplorer.Selection
            If (Not objItem Is Nothing And TypeName(objItem) = "MailItem") Then
                Set objMailItem = objItem
                Set objTaskItem = objApp.CreateItem(olTaskItem)
                With objTaskItem
                    .Subject = objMailItem.Subject
                    .Body = objMailItem.Body
                    .Importance = 2
                End With
                objTaskItem.Close olSave
                Set objTaskItem = Nothing
            End If
        Next
        Set objItem = Nothing
        Set objMailItem = Nothing
    End If
           
    Set objTasksFolder = Nothing
    Set objNamespace = Nothing
    Set objApp = Nothing
    
    ' Now archive the items
    Call MoveToArchive
End Sub
 
Public Function GetFolder(strFolderPath As String) _
  As Outlook.MAPIFolder
    Dim objApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim colFolders As Outlook.Folders
    Dim objFolder As Outlook.MAPIFolder
    Dim arrFolders() As String
    Dim i As Long
    On Error Resume Next
    strFolderPath = Replace(strFolderPath, "/", "\")
    arrFolders() = Split(strFolderPath, "\")
    Set objApp = CreateObject("Outlook.Application")
    Set objNS = objApp.GetNamespace("MAPI")
    Set objFolder = objNS.Folders.Item(arrFolders(0))
    If Not objFolder Is Nothing Then
        For i = 1 To UBound(arrFolders)
            Set colFolders = objFolder.Folders
            Set objFolder = Nothing
            Set objFolder = colFolders.Item(arrFolders(i))
            If objFolder Is Nothing Then
                Exit For
            End If
        Next
    End If
    Set GetFolder = objFolder
    Set colFolders = Nothing
    Set objNS = Nothing
    Set objApp = Nothing
    Set objFolder = Nothing
End Function