从已发送的邮件创建任务并包含附件答案

【问题标题】：Create Task from sent mail and include attachments从已发送的邮件创建任务并包含附件
【发布时间】：2013-02-10 21:26:12
【问题描述】：

在 Outlook 2010 VBA 中，我想在发送电子邮件时创建一个任务。

我想将电子邮件中的所有附件添加到任务中。

我试过.Attachments.Add（不支持），.Attachments = item.Attachments返回属性是只读的。

是否可以或如何将电子邮件附加到任务中？

Public WithEvents myOlApp As Outlook.Application

Private Sub Application_MAPILogonComplete()

End Sub

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
Dim att As MailItem
Dim objMail As Outlook.MailItem

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
        .Body = item.Body
        .Subject = item.Subject
        .StartDate = item.ReceivedTime
        .ReminderSet = True
        .ReminderTime = DateSerial(Year(Now), Month(Now), Day(Now + 1)) + #8:00:00 AM#
        **.Attachments.Add (item.Attachments)**
        .Save
    End With

    Cancel = False
      
End If

Set objTask = Nothing
    
End Sub

【问题讨论】：

如果有人需要，这是最终的代码

标签： email vba outlook task attachment

【解决方案1】：

Attachments.Add 允许将字符串作为参数（完全查询的附件文件名）或 Outlook 项目（例如 MailItem）传递。你将附件集合作为参数传递，你不能这样做。

对于每个附件，先保存附件（Attachment.SaveAsFile），然后将文件名作为参数一次添加到任务中。

【讨论】：

【解决方案2】：

这是我的最终代码

Public WithEvents myOlApp As Outlook.Application

Private Sub Application_MAPILogonComplete()

End Sub

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
Dim att As MailItem
Dim objMail As Outlook.MailItem
Dim Msg As Variant

strFolderPath = "C:\temp" ' path to target folder


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

item.SaveAs strFolderPath & "\" & "test" & ".msg", olMSG

'item.Save

With objTask
    '.Body = strRecip & vbCrLf & Item.Body
    .Body = item.Body
    .Subject = item.Subject
    .StartDate = item.ReceivedTime
    .ReminderSet = True
    .ReminderTime = DateSerial(Year(Now), Month(Now), Day(Now + 1)) + #8:00:00 AM#
    .Attachments.Add item
    .Save
End With

Cancel = False

End If

Set objTask = Nothing

End Sub

【讨论】：