Outlook 2010 VBA Task with attachments

Hams Source

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

emailvbaoutlooktaskattachment

Answers

answered 6 years ago Dmitry Streblechenko #1

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.

answered 6 years ago Hams #2

Here is my final 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
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

comments powered by Disqus