> Automate move of read email to another folder

Automate move of read email to another folder

Posted on Thursday, July 23, 2009 | 4 Comments

Over the last six months I have been investing a bit of time every now and again to improve my working methods. If I can do things better and faster then I can start doing better things with my time. Today I wanted to write up one of them, a way to save me much time and frustration each day processing email.

The solution was to write a macro to go off and file emails I have read into my mail folder tree. The key is that its dynamic and works out where to put messages based on the sender. Sweet.

Some background. Everyone has a different method of handling their email. Some people think they have no method, that just means they have a bad one. My method is that an email stays in my email box until its processed and can go to archive. I try to use a GTD method so most don't stay there for that long. The exception to this rule is I do have a folder under my Inbox called Process, where I move messages that just need some mindless activity that I must do at some stage, I troll this folder every few days when I have a short period of time to kill.

Now I also never delete emails unless they are really spam, advertising or addressed wrong, its amazing how that email you never thought important becomes critical after six months. Many people are like me and file mail away in folders that categorise them. A folder tree works great and anables you to filter mail and perform searches. I have folders for each of the companies that I deal with and for colleagues. This method was great back in the day when the search function in Outlook was slow and painful, it really helped to speed things up.

However I find I spend a lot of time filing messages, there are probably 80 or so folders and even though there are a few speed tricks for moving messages they never really make it truly effective. As you get more and more messages a day that need a scan and file, this time really adds up.

I figured there are three possible solutions to the problem.

  • First you could pre-filter messages using Outlook rules. Many people do this, but to find messages you need to walk the tree and look for unread ones, or use the new search function to list all unread messages. Thats all too messy and will not work great when working between my Blackberry and Outlook.
  • The second option is to just dump everything into a very small set of folders, then use search to categorise. This is close but I am not ready to give up my folder structure just yet.
  • The last option is to automate it. I figured it was a common task and should be simple.

There are quite a few example Macros on the Internet for moving an email to another folder. Most don't work and none were dynamic. So here is what the Macro I wrote does.

Take the selected message and determine a destination folder name based on the sender. Walk the Mail folder tree and find a folder that matches the destination folder name, mark the message as read and move it there. To determine the destination folder name I use two methods. If its an Exchange message I use the first and last name combination. If its an SMTP message, that is external, I pull the domain name. Some external messages I actually want to file by name, so I have it use the first and last name instead for those specific domains.

Now all I need to do is make sure there is a folder somewhere within my tree that matches the domain name or the user name. If it can't find a match the message just stays in the Inbox. It works great!

I created a button with a keyboard shortcut so now as I read my Inbox, if I don't need to do anything further on a message I just hit Alt-X and it disappears into the folder tree. The first email from a company or internal person I just create a folder wherever is appropriate in my folder tree. So for the domain name filed messages I create parent folders that group them, for example Customers and Suppliers. I can move the folders around and it all still works.

Here is the code as it stands today.

Sub FileMessage()

Const olFolderInbox = 6
Dim objItem As Outlook.MailItem
Dim objMailbox As Outlook.MAPIFolder
Dim FolderToSendTo As String

Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objInbox = objNamespace.GetDefaultFolder(olFolderInbox)

strFolderName = objInbox.Parent
Set objMailbox = objNamespace.folders(strFolderName)

Set colItems = objInbox.Items

If objOutlook.ActiveExplorer.Selection.Count = 0 Then
'Require that this procedure be called only when a message is selected
Exit Sub
End If

For Each objItem In objOutlook.ActiveExplorer.Selection
If objItem.Class = olMail Then
' SenderEmailType is "EX" or "SMTP"
' SenderEmailAddress
' SenderName
FolderToSendTo = ""
If objItem.SenderEmailType = "SMTP" Then

' Lets determine the domain name to file in under
atLoc = InStr(objItem.SenderEmailAddress, "@")
DomainName = Right(objItem.SenderEmailAddress, Len(objItem.SenderEmailAddress) - atLoc)

If LCase(DomainName) = "vmware.com" Then
DomainName = Left(objItem.SenderEmailAddress, atLoc - 1)
DomainName = Replace(DomainName, ".", " ") ' Replace dots with spaces
DomainName = Replace(DomainName, "'", "") ' Replace quotes with nothing
End If
FolderToSendTo = DomainName

ElseIf objItem.SenderEmailType = "EX" Then

'MsgBox objItem.SenderName, vbOKOnly + vbExclamation, "INFO"
FolderToSendTo = objItem.SenderName

MsgBox "Don't know what to do, unknown SenderEmailType (not EX or SMTP)", vbOKOnly + vbExclamation, " OPPS"
Exit Sub
End If

' MsgBox "Will look for folder " + FolderToSendTo, vbOKOnly, "INFO"
FindFolder objMailbox, objItem, FolderToSendTo
End If

Set objItem = Nothing
Set objFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
End Sub

Sub FindFolder(oFolder As Outlook.MAPIFolder, theMessage As Outlook.MailItem, theFolderToFind)
Dim folders As Outlook.MAPIFolder
Dim iFolder As Outlook.MAPIFolder
Dim foldercount As Integer

Set theFolders = oFolder.folders
foldercount = theFolders.Count
'Check if there are any folders below oFolder
If foldercount Then
For Each iFolder In theFolders
If theFolderToFind <> "" Then
' Debug.Print iFolder.FolderPath + " ^ " + theFolderToFind
If InStr(LCase(iFolder.FolderPath), "\" + LCase(theFolderToFind)) Then
' Move it to the final location!
theMessage.UnRead = False
theMessage.Move iFolder
theFolderToFind = ""
FindFolder iFolder, theMessage, theFolderToFind
End If
End If
End If
End Sub

I have not done any programming for years (after doing it for the first 10 years of my career), so this was a fun exercise. There are a few tweaks I am thinking of making. But this should give people a good starting place. If I make any big changes I will update the code here.

You could go to town on algorithms on which folder to put messages in, that can be left as an exercise for the reader. If you come up with anything interesting or find this useful post in the comments.



  1. Anonymous2:38 am

    I get so much email, - that I want to keep – that I started searching the internet for a way to automate moving my read email from the Inbox to other folders and I found your script.

    I'm new to VBA and though it would be as easy as copying your script to a macro and then running it, but it doesn't do anything. I don’t know enough about VBA to even start trying to trouble shooting this issue.

    Once I save your script as a macro, I clicked on Tools, Macros, Macros then selected the script and clicked Run. Am I doing it wrong? Could use your help, please.

  2. Um ... see if you can run a simple macro first. Once you can do that review this one to see if its throwing an error or just not doing anything. You may have to call a friend who has a little bit of experience with scripts.

  3. Anonymous3:57 am

    Are you still monitoring this blog? Has anyone come up with an answer to why this script doesn't do anything?

    I don't code VBA and don't know anyone who does. I've posted to blogs asking if some could take a look at your code and tell me why if doesn't do anything, but no responses.

    This code looked like exactly what I needed and I would like to use it.

    Any Help would be appreciated.

  4. Worked for me for ages, don't use it any more. You might have to find someone who can debug it on your machine.


Powered by Blogger.