带有附件的Outlook 2010 VBA任务
Outlook 2010 VBA，我想在发送电子邮件时创建一个任务，但我想从电子邮件中添加所有附件的任务，代码工作正常，但不添加附件，我尝试使用.Attachments.Add（不支持），.Attachments = item.Attachments return propierty是只读的
有可能的？ 或者我如何将漏洞邮件附加到任务上？
谢谢
这里是代码
Public WithEvents myOlApp As Outlook.Application
Private Sub Application_MAPILogonComplete（）
结束小组
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 int Res 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 =“你想为这条信息创建一个任务吗？” intRes = MsgBox（strMsg，vbYesNo + vbExclamation，“创建任务”）
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
设置objTask = Nothing
结束小组
这是我的最终代码
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
Attachments.Add允许传递一个字符串作为参数（完全问题化的附件文件名）或一个Outlook项目（例如MailItem）。 你正在传递Attachments集合作为参数，你不能那样做。
对于每个附件，先保存附件（Attachment.SaveAsFile），然后将它们添加到任务中，一次传递文件名作为参数。
链接地址: http://www.djcxy.com/p/52791.html