Create a task from an email

John Durant recently blogged about his macro to create a task from an e-mail. I thought that was a great idea, so I modified it a bit to suit my purposes. I frequently take an item from my inbox and Edit | Move to Folder and move it to the tasks folder, which creates a task item. I then tab around to set the reminder (which is frustrating if I want it to remind me later today, because if I put 'today' in the due date, it doesn't set the reminder, thus resulting in more keystrokes).

This macro does the following:

1. Takes the items that are selected (it can handle multiple selections of any item type)
2. Creates a task
3. Attaches those items
4. Deletes the items from the source folder
5. Saves the task (so worst case, you can go get the items from the task if you didn't want them to be removed)
6. Sets the reminder on the task to 3 hours from now (you can easily tab into the due date field and set it to tomorrow, tuesday, etc, which will in turn change the reminder)

So, here's what I did:

1. Copy the code into ThisOutlookSession per the instructions in this entry
2. Add a toolbar button for this macro per the instructions in this entry (Note: K as an accelerator isn't used by default in the standard toolbars, so Create Tas&k is a good name - you can also change the icon to something else in that menu as well)

And finally, the code:

Public Sub CreateTaskFromItem()

  Dim olTask As Outlook.TaskItem
'Using object rather than MailItem, so that it
'can handle posts, meeting requests, etc as well
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

Dim cntSelection As Integer
cntSelection = olExp.Selection.Count

For i = 1 To cntSelection
Set olItem = olExp.Selection.Item(i)
olTask.Attachments.Add olItem
olTask.Subject = "Follow up on " & olItem.Subject
olItem.Delete
Next

  olTask.Display
'Set the due date for today
olTask.DueDate = Date
'Set the reminder for 3 hours from now
olTask.ReminderSet = True
olTask.ReminderTime = DateAdd("h", 3, Now)

'Saving the task item, so that in case I close it, I won't lose
'the items which were deleted after being attached to the task
olTask.Save

End Sub