Outlook发送邮件时生成可编辑任务的VBA代码修改需求

以下是调整后的代码，点击确认创建任务后，会自动填充邮件相关信息并弹出任务编辑窗口，你可以自由修改任务日期、提醒设置、正文内容等信息：

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim xYesNo As Integer
    Dim xPrompt As String
    Dim xTaskItem As TaskItem
    Dim xRecipientInfo As String
    Dim Rcp As Recipient
    
    xPrompt = "是否要为这封邮件创建任务？"
    xYesNo = MsgBox(xPrompt, vbYesNo + vbInformation, "邮件转任务")
    
    If xYesNo = vbNo Then Exit Sub
    
    Set xTaskItem = Application.CreateItem(olTaskItem)
    
    ' 拼接收件人信息（显示名称+地址，更直观）
    For Each Rcp In Item.Recipients
        If xRecipientInfo = "" Then
            xRecipientInfo = "收件人：" & Rcp.Name & " (" & Rcp.Address & ")"
        Else
            xRecipientInfo = xRecipientInfo & vbCrLf & "收件人：" & Rcp.Name & " (" & Rcp.Address & ")"
        End If
    Next Rcp
    
    ' 组合任务正文：收件人信息 + 原邮件内容
    xRecipientInfo = xRecipientInfo & vbCrLf & vbCrLf & "原邮件内容：" & vbCrLf & Item.Body
    
    With xTaskItem
        .Subject = "跟进：" & Item.Subject ' 给任务主题加前缀，便于识别
        .StartDate = Date ' 设置任务开始日期为当天
        .DueDate = Date + 3 + CDate("9:00:00 AM") ' 默认3天后上午9点截止
        .ReminderSet = True
        .ReminderTime = Date + 2 + CDate("9:00:00 AM") ' 默认提前1天上午9点提醒
        .Body = xRecipientInfo
        .Display ' 弹出任务编辑窗口，替代原代码的直接保存
    End With
    
    Set xTaskItem = Nothing
    Set Rcp = Nothing
End Sub

关键修改说明 #

• 替换.Save为.Display：原代码会直接静默保存任务，现在改为弹出任务编辑窗口，你可以修改所有任务属性后再手动保存。
• 优化收件人展示：将收件人的名称和地址一起显示，比单纯展示地址更清晰易懂。
• 修正开始日期逻辑：原代码使用Item.ReceivedTime，但刚发送的邮件该属性尚未赋值，改为Date（当天）更合理。
• 添加任务主题前缀：给任务主题加上“跟进：”前缀，方便快速区分这是由邮件生成的待办任务。
• 移除盲错处理：去掉On Error Resume Next，避免隐藏潜在问题，便于调试；若需要保留，可根据实际情况自行添加。

使用步骤 #

1. 打开Outlook，按下Alt + F11打开VBA编辑器。
2. 在左侧项目窗格中找到ThisOutlookSession，双击打开编辑界面。
3. 将上述代码粘贴进去，保存后重启Outlook即可生效。

内容的提问来源于stack exchange，提问作者fletchersmum