Public Sub SendEmailAtt(ByVal MyTo As String, MySybject As String, _
  Optional MyBody As String, Optional MyAttachment As String, _
  Optional MyAttachment2 As String, Optional NoWait As Boolean, Optional FromNameEmail As String)
    Dim OutLookApp As Object      'Ссылка на MS Outlook
    Dim OutLookItem As Object     'Ссылка на сообщение
    Dim OlNotRunning As Boolean   'открыт MS Outlook на момент выполнения
    Dim AdobeApp As Object
    Dim myNameSpace As Object
On Error Resume Next
'Проверяем не открыт ли уже MS Outlook
Set OutLookApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then 'Если ошибка то не открыт и запускаем его
    OlNotRunning = True
    Err.Clear
    Set OutLookApp = CreateObject("Outlook.Application")
End If
'Создание сообщения
Set OutLookItem = OutLookApp.CreateItem(0)
    OutLookItem.To = MyTo                         'кому
    OutLookItem.Subject = MySybject               'тема
    OutLookItem.Body = MyBody                     'текст
    OutLookItem.Attachments.Add MyAttachment      'вложение1
    OutLookItem.Attachments.Add MyAttachment2     'вложение2
    If Nz(FromNameEmail, "") <> "" Then
     OutLookItem.SentOnBehalfOfName = FromNameEmail
    End If
    OutLookItem.Display                           'Отображение сообщения
'Закрытие OutLook если не был запущен до выполнения процедуры отправки
    If OlNotRunning = True Then OutLookApp.Application.Quit
    If NoWait = True Then OutLookItem.send
End Sub