Пример макроса, отправляющего письма со вложениями из Excel через почтовый клиент Outlook:

Sub Отправить_Письмо_из_Outlook()

'отправляем письмо без вложений

res = SendEmailUsingOutlook("name@domain.ru", "Текст письма 1", "Тема письма 1")

If res Then Debug.Print "Письмо 1 отправлено успешно" Else Debug.Print "Ошибка отправки"

'отправляем письмо с 1 вложением

attach$ = ThisWorkbook.FullName ' прикрепляем текущий файл Excel

res = SendEmailUsingOutlook("name@domain.ru", "Текст письма 2", "Тема письма 2", attach$)

If res Then Debug.Print "Письмо 2 отправлено успешно" Else Debug.Print "Ошибка отправки"

'отправляем письмо с несколькими вложениями

Dim coll As New Collection ' заносим в коллекцию список прикрепляемых файлов

coll.Add "C:\Documents and Settings\Admin\Рабочий стол\Tyres.jpg"

coll.Add "C:\Documents and Settings\Admin\Рабочий стол\calc.xls"

coll.Add ThisWorkbook.FullName ' прикрепляем текущий файл Excel

res = SendEmailUsingOutlook("name@domain.ru", "Текст письма 3", "Тема письма 3", coll)

If res Then Debug.Print "Письмо 3 отправлено успешно" Else Debug.Print "Ошибка отправки"

End Sub

Макрос использует функцию SendEmailUsingOutlook, которая:

• принимает в качестве параметров адрес получателя письма, тему и текст письма, список вложений
• запускает Outlook, формирует письмо, и отправляет его
• возвращает TRUE, если отправка прошла успешно, или FALSE, если с отправкой почты вызникли проблемы

Код функции SendEmailUsingOutlook:

Function SendEmailUsingOutlook(ByVal Email$, ByVal MailText$, Optional ByVal Subject$ = "", _

Optional ByVal AttachFilename As Variant) As Boolean

' функция производит отправку письма с заданной темой и текстом на адрес Email

' с почтового ящика, настроенного в Outlook для отправки писем "по-умолчанию"

' Если задан параметр AttachFilename, к отправляемому письму прикрепляется файл (файлы)

On Error Resume Next: Err.Clear

Dim OA As Object: Set OA = CreateObject("Outlook.Application")

If OA Is Nothing Then MsgBox "Не удалось запустить OUTLOOK для отправки почты", vbCritical: Exit Function

With OA.CreateItem(0) 'создаем новое сообщение

.To = Email$: .Subject = Subject$: .Body = MailText$

If VarType(AttachFilename) = vbString Then .Attachments.Add AttachFilename

If VarType(AttachFilename) = vbObject Then ' AttachFilename as Collection

For Each file In AttachFilename: .Attachments.Add file: Next

End If

For i = 1 To 100000: DoEvents: Next ' без паузы не отправляются письма без вложений

Err.Clear: .Send

SendEmailUsingOutlook = Err = 0

End With

Set OutApp = Nothing

End Function

Пример макроса, с получением параметров письма из ячеек листа Excel: 

Sub Отправить_Письмо_из_Outlook()

' адрес получателя - в ячейке A1, текст письма - в ячейке A2

res = SendEmailUsingOutlook(Cells(1, 1), Range("a2"), "Тема письма 1")

If res Then Debug.Print "Письмо 1 отправлено успешно" Else Debug.Print "Ошибка отправки"

End Sub