25Jan Add an Archive button to outlook 2010

I recently moved to a more concise Outlook folder structure:

So then I started spending a lot of time simply moving messages from the inbox to the archived folder. Also when I read a message and move it, it was not marked as read. I hated wasting those precious 2 seconds

So I googled something like “outlook 2010 archive plugin” and ended up at lifehacker:
http://lifehacker.com/5175347/add-a-gmail+like-archive-button-to-microsoft-outlook

The lifehacker example was for outlook 2007 and for an inbox with a single folder (one email address).

I created the certificate, I added the developer tools using this link:
http://msdn.microsoft.com/en-us/library/ee814736.aspx

I enabled Macros using this information:

http://answers.microsoft.com/en-us/office/forum/office_2010-outlook/how-to-enable-macros-in-outlook-2010/791d5b21-c3e9-4e09-89f9-ea53341d7cb0

and I used the following code (worked fine for one folder):

Sub Archive()
Set ArchiveFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Archived")
For Each Msg In ActiveExplorer.Selection
Msg.Move ArchiveFolder
Next Msg
End Sub


Make sure you folder is named “Archived” or change the code.

Now what happened to me was, if I archived an email from my devry folder, it went into the sage/archived. That would not do.
Also the messages were still UnRead = true unless I clicked off of them and back on.

So I used this code for my situation:


Sub Archive()

For j = 1 To Folders.Count
If Folders(j).Name = "Jason.Huber@sage.com" Or Folders(j).Name = "jhuber@devry.edu" Then
If Folders(j).Name = ActiveExplorer.CurrentFolder.Parent Then
Set ArchiveFolder = Folders(j).Folders(2).Folders(1)
For Each Msg In ActiveExplorer.Selection
Msg.UnRead = False
Msg.Move ArchiveFolder
Next Msg
End If
End If
Next j
End Sub


Let me know if it works for you.