Как отправить email с вложение из Outlook с помощью VBA?

Question

[partyboy]

День добрый.
Товарищи, помогите с решением вопроса.
Есть скрипт на VBA, который при событии в календаре отправляет письмо. Как сделать чтобы он добавлял аттач из определенной директории?

Private Sub Application_Reminder(ByVal Item As Object)
  Dim objMsg As MailItem
  Set objMsg = Application.CreateItem(olMailItem)

If Item.MessageClass <> "IPM.Appointment" Then
  Exit Sub
End If

If Item.Categories <> "Automated Email Sender" Then
  Exit Sub
End If

  objMsg.To = Item.Location
  objMsg.Subject = Item.Subject
  objMsg.Body = Item.Body

  objMsg.Send
  Set objMsg = Nothing
End Sub

Answer 1

[h8nor]

Макрос отправляет письмо на "Место события" при появлении оповещения о событии.

' Процедуру разместить в модуле ThisOutlookSession.
' Уровень безопасности макросов (без цифровой подписи) - низкая.
Option Explicit
'123456789012345678901234567890123456h8nor@ya567890123456789012345678toster56789

Private Sub Application_Reminder(ByVal Item As Object)
  Dim objMsg As MailItem, sAttachment As String
  Set objMsg = Application.CreateItem(olMailItem)
  
  ' Путь к файлу вложения (Указанный файл "Текст.txt" находится на Рабочем столе)
  sAttachment = CreateObject("Wscript.Shell").SpecialFolders.Item("Desktop") & "\Текст.txt"
  
  If Item.MessageClass <> "IPM.Appointment" Then
    Exit Sub
  End If
  If Item.Categories <> "Automated Email Sender" Then
    Exit Sub ' Закомментировать, если у события не указана категория
  End If
  
  With objMsg
    .To = Item.Location ' Место события
    .Subject = Item.Subject
    .Body = Item.Body
    ' Если файл вложения существует, то добавить в письмо
    If Len(sAttachment) > 0 Then .Attachments.Add sAttachment
    '.Display '' Показать письмо (для отправки вручную; вместо '.Send)
    .Send
  End With: Set objMsg = Nothing
End Sub

Заметка: Могут быть проблемы при создании писем по просроченным событиям.

Comments

[partyboy]

Спасибо

[h8nor]

На здоровье )