Sub ConvertSelectionToTask()
' You need the GetCurrentItem Function from
' http://slipstick.me/e8mio

    Dim objTask As Outlook.TaskItem
    Dim objMail As Outlook.MailItem
     
    ' Add reference to Word library
    ' in VBA Editor, Tools, References
    Dim objWord As Word.Application
    Dim objInsp As Inspector
    Dim objDoc As Word.Document
    Dim objSel As Word.Selection
   
    On Error Resume Next
    
   Set objMail = GetCurrentItem()
   Set objTask = Application.CreateItem(olTaskItem)

  If Not objMail Is Nothing Then
        If objMail.Class = olMail Then
            Set objInsp = objMail.GetInspector
            If objInsp.EditorType = olEditorWord Then
                Set objDoc = objInsp.WordEditor
                Set objWord = objDoc.Application
                Set objSel = objWord.Selection
        With objSel
           'use wholestory to copy the entire message body 
             .WholeStory
             .Copy
       End With
 
            End If
        End If
    End If
     
 Set objInsp = objTask.GetInspector
 Set objDoc = objInsp.WordEditor
 Set objSel = objDoc.Windows(1).Selection

With objTask
    .Subject = objMail.Subject
    .DueDate = objMail.ReceivedTime + 3
    .StartDate = objMail.ReceivedTime + 2
     objSel.PasteAndFormat (wdFormatOriginalFormatting)
    .Categories = "From Email"
   ' .Save
    .Save
    .Display
   ' .Attachments.Add objMail
    CopyAttachments objMail, objTask
End With

    objMail.Categories = "Task" & objMail.Categories

    Set objTask = Nothing
    Set objMail = Nothing
    Set objSel = Nothing
    Set objInsp = Nothing
    Set objWord = Nothing
 End Sub


Sub CopyAttachments(objSourceItem, objTargetItem)
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder
   strPath = fldTemp.Path & "\"
   For Each objAtt In objSourceItem.Attachments
      strFile = strPath & objAtt.FileName
      objAtt.SaveAsFile strFile
      objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
      fso.DeleteFile strFile
   Next
 
   Set fldTemp = Nothing
   Set fso = Nothing
End Sub