Add Gmail-like "Archive" and "Move to Inbox" Buttons to Outlook


The blog Techdem has instructions for adding a "Done" button to Microsoft Outlook. I've modified the macro code from those instructions and made similar buttons for the toolbars of message windows:

Sub ArchiveSelected()
Set ArchiveFolder = Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderInbox).Parent.Folders("Archive")
For Each Msg In ActiveExplorer.Selection
Msg.UnRead = False
Msg.ClearTaskFlag
Msg.Move ArchiveFolder
Next Msg
End Sub

Sub ArchiveActive()
Set ArchiveFolder = Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderInbox).Parent.Folders("Archive")
Dim myItem As Object
Set myItem = Application.ActiveInspector.CurrentItem
myItem.UnRead = False
myItem.ClearTaskFlag
myItem.Move ArchiveFolder
End Sub

Sub MoveActiveToInbox()
Dim myItem As Object
Set myInbox = Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderInbox)
Set myItem = Application.ActiveInspector.CurrentItem
myItem.Move myInbox
End Sub

Sub MoveSelectedToInbox()
Set myInbox = Application.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderInbox)
For Each Msg In ActiveExplorer.Selection
Msg.Move myInbox
Next Msg
End Sub



Updates: Please see QuickArchive in Outlook for more.