Inbox Zero macros for Outlook

I’m a practitioner of Merlin Mann’s Inbox Zero. The basic idea is that you avoid building up psychic weight by touching email as few times as possible. For each message you must:

  • Do it
  • Defer it
  • Delegate it
  • Delete it

image I have created an Outlook toolbar with these actions. Delete comes first because it is by far the most frequent response. Defer comes next, but is rarely used. Delegate is last to remind me not to become part of the problem. There are only three buttons because after I do it, I delete it.

Part of the freedom of inbox zero comes from allowing yourself to delete messages. You can only truly do this if you know that the information is not irrevocably lost. For that reason, my delete button is not the standard Outlook delete. It just moves the message to an “Archive” folder. Not a categorized, taxonomized, organized folder. Just one big archive that I can search if necessary. I have to search it about twice a month, and I’ve never had trouble finding what I needed.

I’ve written Outlook macros for two of these buttons. They just mark the current message as read and move them to the correct folder: “Archive” for delete, and “Open” for defer.

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 Archive()
    MarkReadAndMove ("\\Mailbox - Perry, Michael\Inbox\Archive")
End Sub

Sub Defer()
    MarkReadAndMove ("\\Mailbox - Perry, Michael\Inbox\Open")
End Sub

Sub MarkReadAndMove(ByVal folderPath As String)
    Dim selectedItem As Object
    Dim archiveFolder As Outlook.Folder

    Set selectedItem = Application.ActiveExplorer.Selection.Item(1)
    Set archiveFolder = GetFolder(folderPath)

    selectedItem.UnRead = False
    selectedItem.Move archiveFolder
End Sub

Change the names as appropriate. I hope you find this as useful as I do.

Leave a Reply

You must be logged in to post a comment.