Freigeben über

Outlook Macros Part 1: Moving Emails Into Personal Folders

  • Artikel

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:

Some items cannot be moved. They were either already moved or deleted, or access was denied.

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:

Outlook Data Files

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.

Creating Outlook 2007 Macros

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.

Creating Outlook 2010 Macros

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.

Comments

  • Anonymous
    December 08, 2010
    I never really thought about it, but this sure beats doing it manually.  I have every work email since 1998 in PSTs...

  • Anonymous
    July 27, 2011
    Hi Robert, I have tried this macro but its throwing an exception as Run Time error ,The operation failed,An object could not be found. Might be some error in this part of code :  strDestFolder = "Personal Folders (" & _                    Year(objVariant.SentOn) & ")"

  • Anonymous
    October 16, 2013
    Can this be changed to months if so how?

  • Anonymous
    October 22, 2013
    A very useful macro. Thanks for posting this :)

  • Anonymous
    March 27, 2014
    Goode one.. moving after 2 months would be useful. How to do that?

  • Anonymous
    March 28, 2014
    @Madhav - all that you would need to do is change the comparison parameters. For example, you could change the macro to calculate the difference in days by using the following syntax:    intDateDiff = DateDiff("d", objVariant.SentOn, Now) And then change the comparison to move anything older than 60 days (~two months) with the following:    If intDateDiff > 60 Then

  • or - You could change the macro to calculate the difference in months by using the following syntax:    intDateDiff = DateDiff("m", objVariant.SentOn, Now) And then change the comparison to move anything older than two months with the following:    If intDateDiff > 2 Then I hope this helps!

  • Anonymous
    October 04, 2014
    Could you please show how to do this: "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. " Thanks.

  • Anonymous
    February 18, 2015
    @Yakov, I realize that your comment is a few months old, but this may help others. If you would like to select your source folder change: Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox) To: Set objSourceFolder = Application.Session.PickFolder This will provide a pop up dialog for you that allows you to select the source folder. As for using the currently selected folder have a look at the following link. www.gregthatcher.com/.../GetFolderInfo.aspx

  • Anonymous
    March 29, 2015
    Hello there. Nice script, works like a charme, i wonder if you would show how to make this: 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. I have a user that has alot of subfolders, so i would love for the user to get it sorted in subfolders on the destination side aswell. So can you prehaps show how to do it, or point in a direction on the web? Thanks.

  • Anonymous
    April 13, 2015
    Thanks for this!  I too would be interested in RenéS's request.

  • Anonymous
    June 07, 2015
    Thank you so much for this.  I'm trying to have all emails in my 1 set of Personal Folders-NOT listed in by separate email accounts.

  • Anonymous
    March 01, 2016
    Hi Robert, Just had a look at the code, just wonder if this could be used for sub-folders under the "Managed Folders" ? Or the code needs to be modified ?