ArtsAutosBooksBusinessEducationEntertainmentFamilyFashionFoodGamesGenderHealthHolidaysHomeHubPagesPersonal FinancePetsPoliticsReligionSportsTechnologyTravel
  • »
  • Technology»
  • Computers & Software

How to Create an Outlook Macro to Flag and Move Mail Message to Follow-up Folder

Updated on June 20, 2012

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:

Sub FlagSelectedMessageForFollowUpAndMove()
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
End Sub
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

Comments

    0 of 8192 characters used
    Post Comment

    No comments yet.