Outlook 2010 VBA Task with attachments
Outlook 2010 VBA, I want to create a task when send an email, but I want to add to the task all the attachments from the email, the code works good but It not add the attachment, I try to use .Attachments.Add (is not supported), .Attachments = item.Attachments return propierty is read only
it is possible? or how can I attach the hole email to the task?
thx
here is the code
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
这是我的最终代码
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 allows to pass a string as a parameter (fully queslified attachment filename) or an Outlook item (such as MailItem). Youy are passing Attachments collection as a parameter, you cannot do that.
For each attachment, save the attachment first(Attachment.SaveAsFile), then add them to the task one at a time passing the file name as the parameter.
链接地址: http://www.djcxy.com/p/52792.html上一篇: 每个VB.net随机数字以不同的标签