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. ;-]
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.
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:
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.
I use a few Outlook constants in this macro, so you could see http://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:
' 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.)
' 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.
' 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.
' 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
' Display the number of items that were moved.
MsgBox "Moved " & lngMovedMailItems & " messages(s)."
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.
Here are some simple customizations that you can make:
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.
I never really thought about it, but this sure beats doing it manually. I have every work email since 1998 in PSTs...
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) & ")"
Can this be changed to months if so how?
A very useful macro. Thanks for posting this :)
Goode one.. moving after 2 months would be useful. How to do that?
@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!
Could you please show how to do this:
"Customizations and Conclusions
You could modify the macro so that it runs on the currently-selected folder rather than specifying the source folder. "
@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)
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.
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 for this! I too would be interested in RenéS's request.
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.