How to Create an Outlook Macro to Flag and Move Mail Message to Follow-up Folder
I follow many of the Getting Things Done methods and when it comes to e-mail I try (usually unsuccessfully) to keep my inbox uncluttered. In Outlook there is a great feature called Flags that will turn an e-mail into an item on the To-Do list without creating a task. Of course if you just flag it you will need to move it if you intend to keep your inbox clean.
To speed up the process of flagging and moving the message I have created the following scripts to move the task to a follow-up folder and flag if for start and completion the following work day. This allows me to review and schedule the task that are processed for follow-up after I have filed the items that need no further action.
I have created a button on the Outlook toolbar to perform this task on the select item but could easily modify the provided code to add additional subroutines that would flag or categorize the items in an infinite number of combinations.
To use the following code just copy and paste it into the macros in Outlook 2007 or Outlook 2010:
On Error Resume Next Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem
FlagForFollowUpNextWeekday Set objNS = Application.GetNamespace("MAPI") Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
'Note to users *** You need to change the folder name and it must be a sub-folder of the inbox Set objFolder = objInbox.Folders("Follow-up Issues") 'Assume this is a mail folder
If objFolder Is Nothing Then MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER" End If
If Application.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 Application.ActiveExplorer.Selection If objFolder.DefaultItemType = olMailItem Then If objItem.Class = olMail Then objItem.Move objFolder End If End If Next
Set objItem = Nothing Set objFolder = Nothing Set objInbox = Nothing Set objNS = Nothing
Sub FlagForFollowUpNextWeekday() 'Based on code presented at: http://skillzdesign.com/blog/2008/01/02/flag-microsoft-outlook-inbox-items-for-follow-up-script/
Dim Days As Integer Dim DayOfWeek As Integer Days = 1 DayOfWeek = DatePart("w", Now() + Days) Do Until (DayOfWeek > 1 And DayOfWeek < 7) Days = Days + 1 DayOfWeek = DatePart("w", Now() + Days) Loop FlagForXDays Days, "Follow Up", "@NotAssigned" End Sub
Sub FlagForXDays(intDays As Integer, strFlagRequest As String, strCategories) 'Based on code presented at: http://skillzdesign.com/blog/2008/01/02/flag-microsoft-outlook-inbox-items-for-follow-up-script/ 'Modified by Marc Rohde (http://marc.rohde-net.us) to the flag by a number of days. Dim Item As Object Dim SelectedItems As Selection Dim dtTaskDate As Date dtTaskDate = CStr(CDate(Format(CDbl(Now) + intDays))) Set SelectedItems = Outlook.ActiveExplorer.Selection For Each Item In SelectedItems With Item .ToDoTaskOrdinal = dtTaskDate .TaskDueDate = dtTaskDate .TaskStartDate = dtTaskDate .FlagStatus = 2 .FlagRequest = strFlagRequest .Categories = strCategories .FlagIcon = 6 .Save End With Next Item End Sub