如何在 Outlook 寄送郵件時自動建立工作？

有時，您可能希望在 Outlook 中寄送郵件時，自動為該郵件建立一項工作。我們在此提供一種快速實現此操作的方法。

使用 VBA 在 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

注意：郵件收件人與內文將自動納入工作內容中。工作的起始日期為郵件寄送日，並於 3 天後到期；系統將於一天後上午 9 點提醒您這項任務，您可依需求自行調整相關設定。

3. 儲存程式碼後，按下「Alt」+「Q」即可關閉 Microsoft Visual Basic for Applications 視窗。

4. 從現在起，當您在新郵件或回覆郵件視窗中點擊「傳送」按鈕時，系統將彈出如下方截圖所示的「建立工作」對話方塊：點擊「是」即可傳送郵件並自動建立工作；點擊「否」則僅傳送郵件，不會建立工作。