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.

[sourcecode language=’vb’]

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

[/sourcecode]