In a discussion about the now-discontinued Getting Things Done Outlook addin in Outlook Forums, John had this comment:

Another function of GTDOA that I will really miss is being able to simultaneously reply to an email message, create a task or appointment, and have that email reply linked to the task or appointment. There is an obvious work-around for this - 1. send my email message, 2. go to my send directory and open it, 3. press "forward" or "reply" 4. CTRL+A to "copy all" of this email 5. close out 6. start a task/appoint and paste into it. *Whew* that is a lot of work! I question if there is an easy way to automate this process.

If you can use a macro, you can use a macro to automate it. I have a macro that comes close at "Automatically create a task when sending a message", but it doesn't add a link to the message. It adds the recipient addresses and the message body to the task, but HTML formatted messages will be copied to the task as text.

This macro gets the EntryID from the sent messages, copies the message body and pastes it into a new Task as formatted text, including the reply header and inserts a link to the original message.

If you prefer to create appointments instead of tasks, search and replace Task with Appointment.

This macro automatically runs when you send a message and needs to be in ThisOutlookSession.

If you want to create a task for every item you send, you can remove the prompt and message box lines.

Option Explicit
Dim strID As String, strLink As String, strLinkText As String
Private WithEvents olSentItems As Items
 
Private Sub Application_Startup()
  Dim objNS As NameSpace
  Set objNS = Application.Session
  ' instantiate objects declared WithEvents
  Set olSentItems = objNS.GetDefaultFolder(olFolderSentMail).Items
  Set objNS = Nothing
End Sub
 
Private Sub olSentItems_ItemAdd(ByVal item As Object)
  On Error Resume Next
  Dim prompt As String
 Dim oForward As MailItem
    prompt$ = "Do you want to create a Task for this message?"
       If MsgBox(prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Create Task?") = vbYes Then
            
        strID = item.EntryID
        strLink = "outlook:" & strID
        strLinkText = item.Subject
        
    CreateTaskForMessage item
       End If
End Sub

Sub CreateTaskForMessage(item As MailItem)
    Dim objTask As Outlook.TaskItem
    Dim objInsp As Outlook.Inspector
    Dim oForward As MailItem
    ' Add reference to Word library
    ' in VBA Editor, Tools, References
    Dim objDoc As Word.Document
    Dim objWord  As Word.Application
    Dim objSel As Word.Selection
    Dim oBookmark As Word.Bookmark
       
    Set oForward = item.Forward
    oForward.Display
        
    Set objInsp = oForward.GetInspector
    If objInsp.EditorType = olEditorWord Then
        Set objDoc = objInsp.WordEditor
        Set objWord = objDoc.Application

   'removes your signature from the top of the Forward     
   If objDoc.Bookmarks.Exists("_MailAutoSig") Then
   Set oBookmark = objDoc.Bookmarks("_MailAutoSig")
        oBookmark.Select
        objDoc.Windows(1).Selection.Delete
     End If
  
   Set objSel = objWord.Selection
    With objSel
    .WholeStory
    .Copy
    End With

    End If

Set objTask = Application.CreateItem(olTaskItem)
    Set objInsp = objTask.GetInspector
    Set objDoc = objInsp.WordEditor
    Set objSel = objDoc.Windows(1).Selection

With objTask
    .Subject = oForward.Subject
    objSel.PasteAndFormat (wdFormatOriginalFormatting)
    objSel.GoTo What:=wdGoToSection, Which:=wdGoToFirst
    objDoc.Hyperlinks.Add objSel.Range, strLink, "", "", strLinkText, ""
    objSel.Range.InsertBefore "Link to "
    .ReminderSet = True
    .ReminderTime = DateSerial(Year(Now), Month(Now), Day(Now + 2)) + #9:00:00 AM#
   .Display
   .Save
End With

oForward.Close olDiscard
End Sub

Choose Task or Appointment

The macro above always creates a Task (or appointment if you change the item type). If you want to choose a task or appointment for each message, use this macro. It first asks if you want to create something, then you'll choose Task (Yes) or Appointment (No). Cancel exits the macro without creating a task or appointment.

The simple MsgBox dialog doesn't support changing Yes and No to other words. If you want the buttons labeled Task and Calendar, you need create a UserForm with buttons labeled Task and Calendar.

This macro automatically runs when you send a message and needs to be in ThisOutlookSession.

Option Explicit
Dim strID As String, strLink As String, strLinkText As String
Private WithEvents olSentItems As Items
 
Private Sub Application_Startup()
  Dim objNS As NameSpace
  Set objNS = Application.Session
  ' instantiate objects declared WithEvents
  Set olSentItems = objNS.GetDefaultFolder(olFolderSentMail).Items
  Set objNS = Nothing
End Sub

Private Sub olSentItems_ItemAdd(ByVal Item As Object)
  On Error Resume Next
  Dim prompt As String
 Dim oForward As MailItem
    prompt$ = "Do you want to create a Task or Appointment for this message?"
       If MsgBox(prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Create Task or Appointment?") = vbYes Then
         
        strID = Item.EntryID
        strLink = "outlook:" & strID
        strLinkText = Item.Subject
        
    CreateTaskForMessage Item
       End If
End Sub


Sub CreateTaskForMessage(Item As MailItem)
    Dim prompt As String
    Dim objNewItem As Object
    Dim objInsp As Outlook.Inspector
    Dim oForward As MailItem
    ' Add reference to Word library
    ' in VBA Editor, Tools, References
    Dim objDoc As Word.Document
    Dim objWord  As Word.Application
    Dim objSel As Word.Selection
    Dim oBookmark As Word.Bookmark
    Dim Response
    
prompt$ = "Do you want to create a Task for this message?" & vbCrLf & "Choose Yes to create a Task." & vbCrLf & "Choose No to create an Appointment."
Response = MsgBox(prompt$, vbYesNoCancel + vbQuestion + vbMsgBoxSetForeground, "Create Task or Appointment?")
If Response = vbCancel Then Exit Sub
        
    Set oForward = Item.Forward
    oForward.Display
        
    Set objInsp = oForward.GetInspector
    If objInsp.EditorType = olEditorWord Then
        Set objDoc = objInsp.WordEditor
        Set objWord = objDoc.Application
        
  'removes your signature from the top of the Forward
   If objDoc.Bookmarks.Exists("_MailAutoSig") Then
   Set oBookmark = objDoc.Bookmarks("_MailAutoSig")
        oBookmark.Select
        objDoc.Windows(1).Selection.Delete
     End If
  
   Set objSel = objWord.Selection
    With objSel
    .WholeStory
    .Copy
    End With

    End If

oForward.Close olDiscard
If Response = vbYes Then

    Set objNewItem = Application.CreateItem(olTaskItem)
    ' set task-only fields here
With objNewItem
    .ReminderSet = True
    .ReminderTime = DateSerial(Year(Now), Month(Now), Day(Now + 2)) + #9:00:00 AM#
End With

Else

    Set objNewItem = Application.CreateItem(olAppointmentItem)
    'set appointment-only fields here
With objNewItem
    .Start = DateSerial(Year(Now), Month(Now), Day(Now + 2)) + #9:00:00 AM#
End With

End If

    Set objInsp = objNewItem.GetInspector
    Set objDoc = objInsp.WordEditor
    Set objSel = objDoc.Windows(1).Selection

With objNewItem
    .Subject = strLinkText
    objSel.PasteAndFormat (wdFormatOriginalFormatting)
    objSel.GoTo What:=wdGoToSection, Which:=wdGoToFirst
    objDoc.Hyperlinks.Add objSel.Range, strLink, "", "", strLinkText, ""
    objSel.Range.InsertBefore "Link to "
   .Display
   .Save
End With

End Sub

Watch more than one Sent folder

This macro watches two sent items folders. You'll need the GetFolderPath function from Working with VBA and non-default Outlook Folders.

If you need to watch more than 2, duplicate these two lines:
Private WithEvents olSentAcct As items
Set olSentAcct = GetFolderPath("diane@contrarytoo.com\Sent Items").items
and the Private Sub olSentAcct_ItemAdd(ByVal item As Object) sub.
Then change olSentAcct in each of the copied lines to something unique.

Option Explicit
Dim strID As String, strLink As String, strLinkText As String

Private WithEvents olSentItems As items
Private WithEvents olSentAcct As items
 
Private Sub Application_Startup()
  Dim objNS As NameSpace
  Set objNS = Application.Session
  ' instantiate objects declared WithEvents
  Set olSentItems = objNS.GetDefaultFolder(olFolderSentMail).items
' additional folders need to use GetFolderPath function
' http://slipstick.me/qf
  Set olSentAcct = GetFolderPath("diane@contrarytoo.com\Sent Items").items
  Set objNS = Nothing
End Sub
 
Private Sub olSentItems_ItemAdd(ByVal item As Object)
' if you need to set a different task folder for each acct
' set a variable to the folder here
    SaveasTask item
End Sub

Private Sub olSentAcct_ItemAdd(ByVal item As Object)
' if you need to set a different task folder for each acct
' set a variable to the folder here
    SaveasTask item
End Sub

Sub SaveasTask(ByVal item As Object)
  On Error Resume Next
  Dim prompt As String
 Dim oForward As MailItem
    prompt$ = "Do you want to create a Task for this message?"
       If MsgBox(prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Create Task?") = vbYes Then
            
        strID = item.EntryID
        strLink = "outlook:" & strID
        strLinkText = item.Subject
        
    CreateTaskForMessage item
       End If
End Sub


Sub CreateTaskForMessage(item As MailItem)
    Dim objTask As Outlook.TaskItem
    Dim objInsp As Outlook.Inspector
    Dim oForward As MailItem
    ' Add reference to Word library
    ' in VBA Editor, Tools, References
    Dim objDoc As Word.Document
    Dim objWord  As Word.Application
    Dim objSel As Word.Selection
    Dim oBookmark As Word.Bookmark
       
    Set oForward = item.Forward
    oForward.Display
        
    Set objInsp = oForward.GetInspector
    If objInsp.EditorType = olEditorWord Then
        Set objDoc = objInsp.WordEditor
        Set objWord = objDoc.Application
On Error Resume Next
   'removes your signature from the top of the Forward
   If objDoc.Bookmarks.Exists("_MailAutoSig") Then
   Set oBookmark = objDoc.Bookmarks("_MailAutoSig")
        oBookmark.Select
        objDoc.Windows(1).Selection.Delete
     End If
 
   Set objSel = objWord.Selection
    With objSel
    .WholeStory
    .Copy
    End With

    End If

Set objTask = Application.CreateItem(olTaskItem)
    Set objInsp = objTask.GetInspector
    Set objDoc = objInsp.WordEditor
    Set objSel = objDoc.Windows(1).Selection

With objTask
    .Subject = oForward.Subject
    objSel.PasteAndFormat (wdFormatOriginalFormatting)
    objSel.GoTo What:=wdGoToSection, Which:=wdGoToFirst
    objDoc.Hyperlinks.Add objSel.Range, strLink, "", "", strLinkText, ""
    objSel.Range.InsertBefore "Link to "
    .ReminderSet = True
    .ReminderTime = DateSerial(Year(Now), Month(Now), Day(Now + 2)) + #9:00:00 AM#
   .Display
   .Save
End With

oForward.Close olDiscard
End Sub

How to use the Macro

First: You will need macro security set to low during testing.

To check your macro security in Outlook 2010 and newer, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security. If Outlook tells you it needs to be restarted, close and reopen Outlook. Note: after you test the macro and see that it works, you can either leave macro security set to low or sign the macro.

Now open the VBA Editor by pressing Alt+F11 on your keyboard. Paste the macro on this page into ThisOutlookSession. You'll need to set a reference to Microsoft Word object library. If you receive a "User-defined type not defined" error, you don't have the reference to Word object library set.

1. Go to Tools, References menu.
2. Locate the object library in the list and add a check mark to it.
   

More information as well as screenshots are at How to use the VBA Editor.