Outlook 2010 VBA任务附件
Outlook 2010 VBA,我想在发送电子邮件时创建一个任务,但是我想从电子邮件中添加所有附件的任务,代码工作正常但不添加附件,我尝试使用.Attachments.Add(不支持),.Attachments = item.Attachments return propierty是只读的Outlook 2010 VBA任务附件
它有可能吗?或者我如何将漏洞邮件附加到任务上?
THX
这里是代码
公共WITHEVENTS myOlApp作为Outlook.Application
私人小组Application_MAPILogonComplete()
末次
私人小组Application_Startup() Initialize_handler End Sub
公用Sub Initialize_handler() 集myOlApp =的CreateObject( “Outlook.Application”) 结束子
私人小组myOlApp_ItemSend(BYVAL项目作为对象,取消由于布尔)
昏暗intRes作为整数 暗淡strMsg作为字符串 昏暗objTask作为TaskItem 集objTask = Application.CreateItem(olTaskItem) 昏暗strRecip作为字符串 昏暗ATT作为的MailItem 昏暗objMail作为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 =无
结束子
Attachments.Add允许通过一个字符串作为参数(完全queslified附件文件名)或Outlook项目(如MailItem)。你正在传递Attachments集合作为参数,你不能那样做。
对于每个附件,先保存附件(Attachment.SaveAsFile),然后将它们添加到任务中,一次传递文件名作为参数。
谢谢您的帮助 – Hams 2013-02-25 21:46:55
这是我最后的代码
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
下面是最终代码的工作,如果有人需要它 – Hams 2013-02-25 21:45:51