This post goes out to Richard Paine who sent me this question last week.
I want to move all the read emails from my inbox into my archive on a click of a button. I know that I can’t do this with the rules provided so have to use a function. Is there an easier way to do this?
Richard is correct that this cannot be done with rules. Of course he could use Outlook’s built-in auto archive function. The problem with auto archive is that it runs on a schedule, not on demand. The solution then is to use a script that Richard can run whenever he wants to.
As with many scripts, this one is very simple. It grabs the Inbox and Archive folders, then loops through the items in the inbox moving all those marked as read to the archive folder. When it finishes it will display a dialog-box letting Richard know it’s done. Like I said, simple stuff.
This solution should work in any version of Outlook.
Follow these instructions to add the code to Outlook.
- Start Outlook
- Press + to open the Visual Basic Editor
- If not already expanded, expand Microsoft Office Outlook Objects
- If not already expanded, expand Modules
- Select an existing module (e.g. Module1) by double-clicking on it or create a new module by right-clicking Modules and selecting Insert → Module.
- Copy the code from the code snippet box and paste it into the right-hand pane of Outlook’s VB Editor window
- Click the diskette icon on the toolbar to save the changes
- Close the VB Editor
Sub ArchiveReadItems() 'On the next line edit the path to your archive folder Const ARCHIVE_PATH = "" Const SCRIPT_NAME = "Archive Read Items" Dim olkInbox As Object, _ olkArchive As Object, _ olkItem As Object, _ intCnt As Integer 'Get the inbox folder Set olkInbox = Session.GetDefaultFolder(olFolderInbox) 'Get the archive folder Set olkArchive = OpenOutlookFolder(ARCHIVE_PATH) 'Loop through the items in the ibox and move those that have been read to the archive For intCnt = olkInbox.Items.Count To 1 Step -1 Set olkItem = olkInbox.Items.Item(intCnt) If Not olkItem.UnRead Then olkItem.Move olkArchive End If Next 'Clean-up Set olkInbox = Nothing Set olkArchive = Nothing Set olkItem = Nothing MsgBox "Archive process complete.", vbInformation + vbOKOnly, SCRIPT_NAME End Sub Function OpenOutlookFolder(strFolderPath) ' Purpose: Opens an Outlook folder from a folder path.' ' Written: 4/24/2009' ' Author: BlueDevilFan' ' Outlook: All versions' Dim arrFolders, varFolder, bolBeyondRoot On Error Resume Next If strFolderPath = "" Then Set OpenOutlookFolder = Nothing Else Do While Left(strFolderPath, 1) = "\" strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1) Loop arrFolders = Split(strFolderPath, "\") For Each varFolder In arrFolders Select Case bolBeyondRoot Case False Set OpenOutlookFolder = olkSes.Folders(varFolder) bolBeyondRoot = True Case True Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder) End Select If Err.Number <> 0 Then Set OpenOutlookFolder = Nothing Exit For End If Next End If On Error GoTo 0 End Function
Adding Buttons to Run the Macro with a Single Click.
You can add toolbar buttons (Outlook 2003) or QAT buttons (Outlook 2007/2010) to run the macros with a single click. Here’s a link to a page that explaining how to do both.