如何在Outlook中发送邮件时自动创建任务？

Author: Siluvia Last Modified: 2025-07-31

有时，您可能需要在Outlook中发送电子邮件时自动为其创建一个任务。在此我们为您提供了一种快速实现此操作的方法。

使用VBA在Outlook中发送邮件时自动创建任务

通过以下VBA代码，您可以根据Outlook中的发送邮件自动创建任务。请按照以下步骤操作。

1. 启动您的Outlook，按“Alt” + “F11”打开“Microsoft Visual Basic for Applications”窗口。

2. 在“Microsoft Visual Basic for Applications”窗口中，将以下VBA代码复制到“ThisOutlookSession”代码窗口中。

VBA代码：在Outlook中发送邮件时自动创建任务

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'Updated by Extendoffice 20181123
    Dim xYesNo As Integer
    Dim xPrompt As String
    Dim xTaskItem As TaskItem
    Dim xRecipient As String
    On Error Resume Next
    xPrompt = "Do you want to create a task for this message?"
    xYesNo = MsgBox(xPrompt, vbYesNo + vbInformation, "Kutools for Outlook")
    Cancel = False
    If xYesNo = vbNo Then Exit Sub
    Set xTaskItem = Application.CreateItem(olTaskItem)
    For Each Rcp In Item.Recipients
        If xRecipient = "" Then
            xRecipient = Rcp.Address
        Else
            xRecipient = xRecipient & vbCrLf & Rcp.Address
        End If
    Next Rcp
    xRecipient = xRecipient & vbCrLf & Item.Body
    With xTaskItem
        .Subject = Item.Subject
        .StartDate = Item.ReceivedTime
        .DueDate = Date + 3 + CDate("9:00:00 AM")
        .ReminderSet = True
        .ReminderTime = Date + 2 + CDate("9:00:00 AM")
        .Body = xRecipient
        .Save
    End With
    Set xTaskItem = Nothing
End Sub