Outlook Macros Part 1: Moving Emails Into Personal Folders

I'd like to take a brief departure from my normal IIS-related blogs and write about something that we use everyday - email; and in my specific situation I am using Microsoft Office Outlook. So if you just want IIS information, you can stop reading now - otherwise, you are proceeding at your own risk. ;-]

There's an old adage that says, "If you don't write something down then you'll forget it, " and for my own benefit that's more or less what I'm doing here. I wrote some special-purpose macros that I would probably lose unless I put them somewhere where I can find them easily. But that being said, free code is always nice, so I thought that I'd convert these macros into a few blogs that might help someone else at the same time. ;-]

My Email Dilemma

To start things off, I need to give you some background information about why I wrote the macro in this blog post. I know that everyone manages their emails and archives differently, but as a matter of personal preference I don't use the Outlook auto-archive features; I prefer to use Personal Folders (*.PST) files that I manage myself, and I create a new PST file each year. We use Exchange servers here at Microsoft, and when my mail folders on my Exchange server start to fill up I move some of the mails into a PST file. For my part, I simply wait for an automated email from my server letting me know that my mailbox is almost full, then I move a bunch of emails and wait a couple months for the cycle to repeat itself. It's a pretty simple method that's served me well for well over a decade, so I'm pretty happy with it.

That being said, as each new version of Exchange is released, the administrators that manage our Exchange servers keep increasing the size of our mail storage on the servers, which means that I can usually work for a couple of months without having to think about moving emails off the server into a PST file. So a couple of days ago I wasn't surprised when I received a piece of automated email telling me that my mailbox was almost full, and I started highlighting huge chunks of emails and dragging them off to my current PST file. What was disconcerting was the large number of times that I received the following popup dialog:

It soon dawned on me that perhaps I was trying to move too many files at a time, so I started over with a very small number of emails and that was successful. Then I kept increasing the number of emails until I started seeing failures, which to my dismay was still a very small number of emails - I could only move around 100 emails before I would get the error message. Since it had been several months since I last cleaned up my email, and the specific emails that I was attempting to move were from a very active distribution list to which I belong, I could rapidly see that it was going to take me hours to move all of those emails.

Whenever I am faced with such a situation, I quickly realize that it's better to write some code instead of wasting hours my day repeating the same operation over and over. As luck would have it, I've written a lot of Office macros over time, so the idea of writing a macro to move emails from my server into my PST files seemed like an easy enough task.

My Email Setup

First things first - I need to explain how I name my Personal Folders (*.PST) files. You don't have to follow my setup, but some of my settings will be important when I explain my macro later. So you might need to change things accordingly for your environment.

I name my Personal Folders for each year, which stands to reason, and I usually keep two or three attached in Outlook at any given time. For example, I have PST files for the past three years in Outlook, so I have Personal Folders that are named like the following:

• Personal Folders (2009)
• Personal Folders (2008)
• Personal Folders (2007)

This looks like the following illustration from my Mail Settings in the Windows Control Panel:

Once again, you don't have to use this configuration for your computer, but you would need to update the macro as necessary.

The Macro

I use a few Outlook constants in this macro, so you could see https://support.microsoft.com/kb/285202 for a large list of Outlook constants in case you use if you want to customize the list of mail objects that this macro will move. In this example, I am specifically moving only mail objects and meeting requests.

To create a macro in Outlook 2007, click on Tools, then Macro, then Visual Basic Editor. Once the Microsoft Visual Basic window opens, expand the project folders until you see ThisOutlookSession, then double-click that to open the Visual Basic Editor.

I am using Outlook 2010, so to create a macro I needed to click on the Developer tab on the ribbon, then click on the Visual Basic icon.

Once the Visual Basic editor opens, paste in the following code:

 Sub MoveOldEmails()

    ' Declare all variables.
    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim objSourceFolder As Outlook.MAPIFolder
    Dim objDestFolder As Outlook.MAPIFolder
    Dim objVariant As Variant
    Dim lngMovedMailItems As Long
    Dim intCount As Integer
    Dim intDateDiff As Integer
    Dim strDestFolder As String
    
    ' Create an object for the Outlook application.
    Set objOutlook = Application
    ' Retrieve an object for the MAPI namespace.
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    ' Retrieve a folder object for the source folder.
    Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
    
    ' Loop through the items in the folder. NOTE: This has to
    ' be done backwards; if you process forwards you have to
    ' re-run the macro an inverse exponential number of times.
    For intCount = objSourceFolder.Items.Count To 1 Step -1
        ' Retrieve an object from the folder.
        Set objVariant = objSourceFolder.Items.Item(intCount)
        ' Allow the system to process. (Helps you to cancel the
        ' macro, or continue to use Outlook in the background.)
        DoEvents
        ' Filter objects for emails or meeting requests.
        If objVariant.Class = olMail Or objVariant.Class = olMeetingRequest Then
            ' This is optional, but it helps me to see in the
            ' debug window where the macro is currently at.
            Debug.Print objVariant.SentOn
            ' Calculate the difference in years between
            ' this year and the year of the mail object.
            intDateDiff = DateDiff("yyyy", objVariant.SentOn, Now)
            ' Only process the object if it isn't this year.
            If intDateDiff > 0 Then
                ' Calculate the name of the personal folder.
                strDestFolder = "Personal Folders (" & _
                    Year(objVariant.SentOn) & ")"
                ' Retrieve a folder object for the destination folder.
                Set objDestFolder = objNamespace.Folders(strDestFolder).Folders("Inbox")
                ' Move the object to the destination folder.
                objVariant.Move objDestFolder
                ' Just for curiousity, I like to see the number
                ' of items that were moved when the macro completes.
                lngMovedMailItems = lngMovedMailItems + 1
                ' Destroy the destination folder object.
                Set objDestFolder = Nothing
            End If
        End If
    Next
    
    ' Display the number of items that were moved.
    MsgBox "Moved " & lngMovedMailItems & " messages(s)."

End Sub

When you run this macro, it will loop through all the mail objects in your inbox and move them to the corresponding inbox in the personal folders file based on the year.

Customizations and Conclusions

Here are some simple customizations that you can make:

• You could modify the macro so that it runs on the currently-selected folder rather than specifying the source folder.
• You can change the folder for the emails by appending another folder name to the folder declaration. For example:
  • Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox).Folders("FooBar")
  • Set objDestFolder = objNamespace.Folders(strDestFolder).Folders("FooBar")
• You could modify the macro so that it loops through the collection of subfolders under the source inbox and moves all of the emails to their corresponding folders in the destination personal folder.

Personally, I like manually running this macro on a single folder, but that's just me. ;-]

In the end I spent more time writing this blog than I did the macro, but it was time well spent - I moved thousands of pieces of email in a very short amount of time, so I didn't have to spend my afternoon copying and pasting my emails.