Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim intRes As Integer
Dim strMsg As String
Dim objTask As TaskItem
Set objTask = Application.CreateItem(olTaskItem)
Dim strRecip As String
strMsg = "Do you want to create a task for this message?"
intRes = MsgBox(strMsg, vbYesNo + vbExclamation, "Create Task")
If intRes = vbNo Then
Cancel = False
Else
For Each Recipient In Item.Recipients
strRecip = strRecip & vbCrLf & Recipient.Address
Next Recipient


    ' 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 item = GetCurrentItem()
   Set objTask = Application.CreateItem(olTaskItem)

  If Not item Is Nothing Then
        If item.Class = olMail Then
            Set objInsp = item.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 = Item.Subject
   ' .DueDate = item.ReceivedTime + 3
   ' .StartDate = item.ReceivedTime + 2
     objSel.PasteAndFormat (wdFormatOriginalFormatting)
 	objSel.HomeKey Unit:=wdStory
	objSel.InsertBefore "See attachments: " &strAtt & vbCrLf & vbCrLf
    .Save
    .Display
    .Attachments.Add item
End With


Cancel = False
End If
Set objTask = Nothing
End Sub