Getting your outlook archiving up to speed

Today I had trainingday planned to get an upgrade for my time-management skills (Yes, IT-guys get upgrades). One of the things we discussed in the training was how to archive your mail. I have a pretty sizable mailbox of about 1.5Gb, so it might be a good idea to have a good archiving structure instead of an inbox containing 4300+ items.

The idea is that you create a structure that has an Archive folder as its root and folders for each letter underneath it. Using this you can create folders for specific topics underneath the letters to make things easier to find.

You could of course create this structure by hand, but I wouldn’t be much of an IT-guy if I didn’t have a better (faster) trick up my sleeve.

The following Macro will create the folder structure for you, so you don’t have to make 27 folders by hand.

   1: Sub CreateArchiveFolders()

   2:  

   3:     Dim objInboxFolder As Outlook.MAPIFolder

   4:     Dim objArchiveFolder As Outlook.MAPIFolder

   5:     Dim strAlphabet As String

   6:     

   7:     strAlphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

   8:     

   9:     Set objInboxFolder = Application.Session.GetDefaultFolder(olFolderInbox)

  10:     Set objArchiveFolder = objInboxFolder.Folders.Item("Archief")

  11:     

  12:     If objArchiveFolder Is Nothing Then

  13:         Set objArchiveFolder = objInboxFolder.Folders.Add("Archief")

  14:     End If

  15:     

  16:     For x = 1 To Len(strAlphabet)

  17:         Dim strFolderName As String

  18:         strFolderName = Mid(strAlphabet, x, 1)

  19:         

  20:         CreateFolder objArchiveFolder, strFolderName

  21:     Next

  22:  

  23:     Set objArchiveFolder = Nothing

  24:     Set objInboxFolder = Nothing

  25: End Sub

  26:  

  27: Function CreateFolder(objParentFolder As Outlook.MAPIFolder, strFolderName As String)

  28:     On Error GoTo ErrorHandler

  29:  

  30:     Dim objNewFolder As Outlook.MAPIFolder

  31:  

  32:     Set objNewFolder = objParentFolder.Folders.Add(strFolderName)

  33:     Set CreateFolder = objNewFolder

  34:  

  35: ErrorHandler:

  36:     Exit Function

  37: End Function

The macro should work on Outlook 2003 and newer. I have checked Outlook 2010, but the API hasn’t changed much for this kind of functionality, so you should be fine in older versions too.

Now to get my backlog processed…