Automatically create a task when sending a message

This application startup macro watches for the user to send an email and asks if they want to create a task for the message. If they choose no, the message is sent. If they select yes then a task is created before the message is sent.

The code adds the message recipients to the task body, along with the message body. The start date is "today" (when the message is sent) and the due date is 2 days from now. The reminder is set for 2 days from now at 9 AM.

To automatically create tasks for messages you receive, see Create a Task from an Email using a Rule

Create task from sent message macro

To use this macro:

1. Set macro security to low.
2. Open the VBA Editor (Alt+F11)
3. Expand Project1 to find ThisOutlookSession
4. Copy the macro and paste at the top of ThisOutlookSession

Edit the start date, due date, and reminder time fields as needed.

To test the macro, click in the Application_Startup procedure and click the Run button then send a message.

Public WithEvents myOlApp As Outlook.Application

Private Sub Application_Startup()
    Initialize_handler
End Sub

Public Sub Initialize_handler()
    Set myOlApp = CreateObject("Outlook.Application")
End Sub

Private Sub myOlApp_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

With objTask
    .Body = strRecip & vbCrLf & Item.Body
    .Subject = Item.Subject
    .StartDate = Item.ReceivedTime
    .ReminderSet = True
    .ReminderTime = DateSerial(Year(Now), Month(Now), Day(Now + 2)) + #9:00:00 AM#
    .Save
End With

    Cancel = False
      
    End If

Set objTask = Nothing
    
End Sub

Related Posts:

1. Use VBA to check Outlook's outgoing messages for attachments and cance

   Do you want to send an attachment?
2. A macro that checks the number of recipients on an outgoing Outlook me

   Check messages you send for number of recipients
3. 

   Create a Task from an Email using a Rule
4. 

   Reply using the address a message was sent to