The following macros are for enabling one-click task creation from email in Microsoft Outlook 2003 and 2007.

Note: Before attempting to use the macros, please read the post on working with email in Outlook if you haven’t already.

To copy the source code to your clipboard, just click the “copy to clipboard” icon in the top right corner of the code.  Do not try and copy and paste by highlighting directly as it won’t work.

Public Sub CreateTaskFromItem(TheType As String)

  Dim olTask As Outlook.TaskItem
  Dim olItem As Object
  Dim olExp As Outlook.Explorer
  Dim fldCurrent As Outlook.MAPIFolder
  Dim olApp As Outlook.Application

  Set olApp = Outlook.CreateObject("Outlook.Application")
  Set olTask = olApp.CreateItem(olTaskItem)
  Set olExp = olApp.ActiveExplorer
  Set fldCurrent = olExp.CurrentFolder
  Set NameSpace = olApp.GetNamespace("MAPI")
  Set Inbox = NameSpace.GetDefaultFolder(6)

  Dim cntSelection As Integer
  cntSelection = olExp.Selection.Count

    For i = 1 To cntSelection
    Set olItem = olExp.Selection.Item(i)
    olTask.Attachments.Add olItem
    If TheType = "Waiting For" Then
        If olItem.SenderName = "YOUR NAME" Then
            olTask.Subject = olItem.Recipients.Item(1).Name & ": " & olItem.ConversationTopic
        Else
            olTask.Subject = olItem.SenderName & ": " & olItem.ConversationTopic
        End If
    Else
        olTask.Subject = "Follow up on " & olItem.ConversationTopic

    End If

    olItem.Move Inbox.Folders("Archive")

  Next

  olTask.Display

  'Someday Maybe tasks don't need due dates by default
  If TheType <> "Someday" Then

    'Action are created on Friday or Saturday should be set to monday
    Select Case Weekday(Now(), vbSunday)
        Case 1, 2, 3, 4, 5
            olTask.DueDate = DateAdd("d", 1, Date)
        Case 6
            olTask.DueDate = DateAdd("d", 3, Date)
        Case 7
            olTask.DueDate = DateAdd("d", 2, Date)
    End Select
  End If
  olTask.Categories = TheType

End Sub

Public Sub NextAction()
    CreateTaskFromItem ("Next Actions")
End Sub

Public Sub Someday()
    CreateTaskFromItem ("Someday")
End Sub

Public Sub WaitingFor()
    CreateTaskFromItem ("Waiting For")
End Sub