Create Followup Task Reminders with VBA

This macro, attached to a toolbar button in a mail message, creates a followup task on the email and attaches the original msg to the task. You can also run it from the explorer window, just select ONE email message, then run the code. This is based on code found in Sue Mosher's book and here as well.

I recommend you drag this macro to one of the Explorer toolbars, and also open a mail message and add it to one of the message toolbars, so you can use it in either circumstance.

Make sure you copy both code blocks.

Sub CreateFollowUpTask()
'
' you can specify how many (business) days later you want the reminder
'
' don't forget to include the 'NextBusinessDay' function as well, if you copy
' this code somewhere else
'

  Dim objNS As Outlook.NameSpace
  Set objNS = Application.GetNamespace("MAPI")

  Dim objItem As Outlook.MailItem
  Dim objTask As Outlook.TaskItem
  Dim NumOfDays As Integer
  Dim DayToRemind As Date
  Const attPath As String = "C:\"

  ' set reference to email being viewed
  '
  ' if we are running this code from the Inbox, then no email would be
  ' displayed, so we'll try to check the selection first
  '

  On Error Resume Next
  Set objItem = Outlook.ActiveInspector.CurrentItem

  If objItem Is Nothing Then

    ' we are probably in the explorer window

    If (ActiveExplorer.Selection.Count = 1) And _
       (ActiveExplorer.Selection.Item(1).Class = olMail) Then
      Set objItem = ActiveExplorer.Selection.Item(1)
    End If
  End If
  On Error GoTo 0

  If objItem Is Nothing Then

    ' no email was displayed and no email was selected from the explorer window,
    ' cannot set reference to anything

    MsgBox "I was not able to create a task. Please run this code ONLY " & _
           "under one of the following conditions:" & vbCr & vbCr & _
           "-- You are viewing an email message." & vbCr & _
           "-- You are in your Inbox and have exactly one message selected.", _
           vbInformation
    GoTo ExitProc
  End If

  Set objTask = Outlook.CreateItem(olTaskItem)

  ' ask for days input

  NumOfDays = InputBox("How many business days until reminder?")

  ' get date of next business day using function below

  DayToRemind = NextBusinessDay(Format(Now, "Short Date"), NumOfDays)

  With objTask
    .StartDate = DayToRemind
    .Subject = "Reminder For Followup: " & objItem.Subject
    .Status = olTaskInProgress
    .Importance = objItem.Importance
    .DueDate = DayToRemind
    .ReminderSet = True

    ' embed original email in the task
    '
    ' first, save message copy

    objItem.SaveAs attPath & objItem.EntryID

    ' then, embed message copy

    objTask.Attachments.Add attPath & objItem.EntryID, olEmbeddeditem, , "Original Message"

    ' last, delete saved copy

    Kill (attPath & objItem.EntryID)

    .Save
  End With

ExitProc:

End Sub

See Get Previous Business Day in VBA for the NextBusinessDay function.

If you want a function that returns the next *working* day (i.e. minus holidays), check out my blog post Calculate Working Days Minus Holidays in VBA.