MS OutLook - Создание и отправка сообщения с вложением (опционально) и экспортом в файл копии (опционально)

Полезная инфа:
MailItem Object (Outlook): https://msdn.microsoft.com/ru-ru/library/office/ff861332.aspx
OlItemType Enumeration (Outlook): https://msdn.microsoft.com/ru-ru/library/office/ff869291.aspx.  

Пример применения:

SendEmailWtAttachment "name@domen.ru", "Тема", "Текст Сообщения", "C:\Temp\filename.zip"

SendEmailWtAttachment "8768972867077@gmail.com", "test01", "Привет!", , "d:\temp"

      Причем если необходимо передать сообщение нескольким адресатам, то в строку адреса можно предать несколько адресов разделяя их точкой с запятой и пробелом.

Public Sub SendEmailWtAttachment(sToEMails$, sSybject$, Optional sBody$, _

Optional sAttachmentPath$, Optional sSaveCopyToFolder$)

'es 16.02.05 - 06.05.2017

'----------------------------------------------------------------------------

'MS Access VBA - процедура отправки сообщения посредством MS OutLook

'с вложением (опционально) и сохранением файла копии (опционально)

'es 16.02.05 - 06.05.2017

'----------------------------------------------------------------------------

'Аргументы:

' sToEMails 'Адрес, или адреса через точку с запятой

' sSybject 'Тема

' sBody 'Текст (тело сообщения)

' sAttachmentPath 'Полный путь к вложению (опционально)

' sSaveCopyToFolder 'Путь к к папке куда сохранить копию (опционально)

'----------------------------------------------------------------------------

'Полезная инфа:

' * MailItem Object (Outlook)

' https://msdn.microsoft.com/ru-ru/library/office/ff861332.aspx

' * OlItemType Enumeration (Outlook)

' https://msdn.microsoft.com/ru-ru/library/office/ff869291.aspx

'----------------------------------------------------------------------------

Dim olObjApp As Object 'Ссылка на MS Outlook

Dim olObjItem As Object 'Ссылка на сообщение

Dim s$

On Error GoTo SendEmailWtAttachmentErr

Set olObjApp = CreateObject("Outlook.Application")

Set olObjItem = olObjApp.CreateItem(0) '0 = письмишко значит ...

'* cм https://msdn.microsoft.com/ru-ru/library/office/ff869291.aspx

'Создание сообщения

With olObjItem

.To = sToEMails 'кому

.Subject = sSybject 'тема

.Body = sBody 'текст

'* Если нужно несколько вложений - можно поиграть с коллекцией ниже

'* и именить аргумент процедуры на массив например, но не будем усложнять

If sAttachmentPath <> "" Then

If Dir(sAttachmentPath) <> "" Then

.Attachments.Add sAttachmentPath

End If

End If

'.Display 'Отображение сообщения (если нужно)

.Save 'Сохранение сообщения (пока в Черновиках)

'Но это не фактическая отправка, а только помещение в папку "Исходящие" (OutBox)

.Send

'... а далеше OutLook будет действовать по своим настройкам ("Мгновенная отправка")

'Экспортирование - если указан аргумент

If sSaveCopyToFolder <> "" Then

s = sSaveCopyToFolder

If Right(s, 1) <> "\" Then s = s & "\"

' а можно м с этим: .EntryID = строчка в 50 (!!!) симсолов

s = s & sSybject & ".msg" 'Путь сохранения копии

Debug.Print s

.SaveAs s, 3 'Схраняем ...

'... и тут 3 = olObjSaveAsMsg (MS OutLook Format *.msg)

End If

End With

Set olObjItem = Nothing

Set olObjApp = Nothing

Exit Sub

SendEmailWtAttachmentErr:

If Err.Number = "287" Then 'На всякий случай

MsgBox "Вы отказались от создания сообщения!", vbInformation, "Сообщение не создано"

Else

MsgBox Err.Description, vbCritical, "Error!"

End If

End Sub