Макрос для excel отправка почты через outlook

Пример макроса, отправляющего письма со вложениями из 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 SettingsAdminРабочий столTyres.jpg»

coll.Add «C:Documents and SettingsAdminРабочий стол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

Информация о материале

Категория: Макросы Excel

Опубликовано: 24 апреля 2013

Sub SendMail()
    Dim objOL As Object
    Dim objMail As Object
    Set objOL = CreateObject("Outlook.Application")
    Set objMail = objOL.CreateItem(0)
        With objMail
            .To = "здесь указывается адрес получателя письма"
            .CC = "здесь указывается адрес получателя копии"
            .Body = "Текст письма"               'указывается текст письма
            .Subject = "Тема письма"             'указывается тема письма
            .Attachments.Add "C:outtest.txt"   'указывается полный путь к файлу
            .Send
        End With
    Set objMail = Nothing
    Set objOL = Nothing
End Sub

Возникла задача организации рассылки писем по списку e-mail пользователей в Excel. В каждом письме будут содержаться некоторые данные, индивидуальные для каждого пользователя, и приложен персональный файл. В этой статье, мы рассмотрим, как использовать Outlook для автоматической рассылки писем по списку из Excel с помощью VBA макроса или PowerShell

Важно. Оба способа отправки писем подразумевают, что на вашем компьютере установлен и настроен почтовый профиль Outlook. Именно с этого почтового ящика (и e-mail адреса) будет выполнятся рассылка.

Допустим, у нас есть Excel файл, содержащий следующие столбцы:

Email пользователя | ФИО | Время последней смены пароля | Статус учетной записи

В рамках моей задачи нужно каждому пользователю из списка отправить письмо вида:

Тема: Статус учетной записи в домене winitpro.ru
Тело письма: Уважаемый %FullUsername%
Ваша учетная запись в домене winitpro.ru — %status%
Время последней смены пароля: %pwdchange%

Совет. Если для учетных записей пользователей нужно получить значение одного из атрибутов пользователя в Active Directory, можно воспользоваться решением из статьи Функция Excel для получения данных пользователя из AD.

VBA макрос в Excel для рассылки писем из Outlook

Сначала рассмотрим небольшой макрос отправки писем на языке VBA (Visual Basic for Applications), который можно создать прямо в документе Excel.

Создайте новый макрос: вкладка Вид -> Макросы. Укажите имя макроса send_email и нажмите кнопку Создать:

В открывшемся редакторе VBA вставьте следующий код (я снабдил его всеми необходимыми комментариями). Для автоматизации отправки писем я воспользуюсь функцией CreateObject(«Outlook.Application»), позволяющей создать и использовать в скрипте объект приложения Outlook.

Sub send_email()
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
Dim Dest As Variant
Dim SDest As String
' тема письма
strSubj = "Статус учетной записи в домене winitpro.ru"
On Error GoTo dbg
' создаем новый объект типа Outlook
Set olApp = CreateObject("Outlook.Application")
For iCounter = 2 To WorksheetFunction.CountA(Columns(1))
' создаем новый элемент (письмо) в Outlook
Set olMailItm = olApp.CreateItem(0)
strBody = ""
useremail = Cells(iCounter, 1).Value
FullUsername = Cells(iCounter, 2).Value


Status = Cells(iCounter, 4).Value
pwdchange = Cells(iCounter, 3).Value
'формируем тело письма
strBody = "Уважаемый " & FullUsername & vbCrLf
strBody = strBody & "Ваша учетная запись в домене winitpro.ru " & Status & vbCrLf
strBody = strBody & "Время последней смены пароля: " & pwdchange & vbCrLf
olMailItm.To = useremail
olMailItm.Subject = strSubj
'добавляем вложение, формат имени файла [email protected] . Если вложение не нужно, закомментируйте следующую строку
olMailItm.Attachments.Add ("C:ps" & useremail & ".txt")
olMailItm.BodyFormat = 1
' 1 - текстовый формат письма, 2 -  HTML формат
olMailItm.Body = strBody
olMailItm.Send
'следующую строку можно использовать для отладки текста письма, закомментировав предыдущую
'MsgBox strBody
Set olMailItm = Nothing
Next iCounter
Set olApp = Nothing
dbg:
'отображение ошибок, если есть
If Err.Description <> "" Then MsgBox Err.Description
End Sub

Данный Excel файл нужно сохранить с расширением xlsm (формат книги Excel с поддержкой макросов). Для запуска рассылки выберите созданную процедуру (макрос) и нажмите кнопку выполнить.

Макрос последовательно перебирает все строки на листе Excel, формирует и отправляет по одному письму на каждый Email из списка. Отправленные письма сохраняются в папку Sent Items Outlook.

Отправить письмо из Outlook с помощью PowerShell

В PowerShell можно использовать командлет Send-MailMessage для отправки писем, однако он требует выполнения аутентификации на почтовом сервере перед отправкой и не поддерживает современные методы проверки подлинности, такие как в том числе OAuth и Microsoft Modern Authentication. Поэтому, если на вашем компьютер есть настроенный профиль Outlook, гораздо проще использовать его для отправки писем.

Ниже приведен пример скрипта PowerShell, который получает данные из Excel файла и использует Outlook для отправки письма для каждого пользователя:

# открыть Excel файл
$ExcelObj = New-Object -comobject Excel.Application
$ExcelWorkBook = $ExcelObj.Workbooks.Open("C:PSuser_list.xlsx")
$ExcelWorkSheet = $ExcelWorkBook.Sheets.Item("Sheet1")
# Получаем количество заполненных строк в xlsx файле
$rowcount=$ExcelWorkSheet.UsedRange.Rows.Count
# Перебираем все строки в столбце 1, начиная со второй строки (в этих ячейках указано доменное имя пользователя)
for($i=2;$i -le $rowcount;$i++){
$useremail = $ExcelWorkSheet.Columns.Item(1).Rows.Item($i).Text
$FullUsername =  $ExcelWorkSheet.Columns.Item(2).Rows.Item($i).Text
$Status =  $ExcelWorkSheet.Columns.Item(4).Rows.Item($i).Text
$pwdchange = $ExcelWorkSheet.Columns.Item(3).Rows.Item($i).Text
# формируем тело письма
$strSubj = "Статус учетной записи в домене winitpro.ru"
$strBody = "Уважаемый " + $FullUsername
$strBody = $strBody + " `r`n Ваша учетная запись в домене winitpro.ru " + $Status
$strBody = $strBody + "`r`n Время последней смены пароля: " +  $pwdchange
$strfile="C:ps" + $useremail + ".txt"
# предполагаем, что Outlook открыт, если нет нужно запустить его командой $outlook = new-object -comobject outlook.application
$outlook = [Runtime.InteropServices.Marshal]::GetActiveObject("Outlook.Application")
$email = $outlook.CreateItem(0)
$email.To = $useremail
$email.Subject = $strSubj
$email.Body =  $strBody
# добавить вложение (если нужно)
$email.Attachments.add($strfile)
#отправить письмо
$email.Send()
}
$ExcelWorkBook.close($true)

Данный PowerShell скрипт предполагает, что на компьютере запущен Outlook. Для каждого email адреса из XLSX файла скрипт генерирует тему и текст письма и прикрепляет файл. Затем выполняется отправка письма.

Хитрости »

1 Май 2011              386285 просмотров

Прежде чем начать читать статью прошу принять к сведению объявление: используйте СВОИ АДРЕСА ЭЛ.ПОЧТЫ при тестировании кодов. Не надо отсылать письма на указанные в статье e-mail адреса- это все приходит мне на почту. Помимо этого Вы сами не сможете понять работает или нет, т.к. письма придут мне, а не Вам.
Спасибо за понимание
P.S. А если написанное выше Вы все же проигнорировали и отправили письмо на мои адреса электронной почты — это означает, что Вы соглашаетесь с тем, что вся информация внутри письма, включая вложения, может быть использована мной без ограничений в личных целях.

• Отправка через меню Excel
• Простая отправка книги через VBA без Outlook
• Отправка писем через VBA при помощи Outlook(с вложениями)
• Отправить письма через Outlook с картинкой в теле письма
• Массовая рассылка писем по адресам при помощи Outlook
• Отправка сообщения без использования Outlook — используем CDO

Отправить письмо из Excel можно несколькими способами, в том числе и через написание кода в VBA.

Отправка через меню Excel
Отправку без кода осуществить достаточно просто:

• Excel 2003: Файл(File) —Отправить(Send To) —Сообщение(Mail Recipient)
  и выбрать способ отправки:
  • Сообщение(Mail Recipient) — создается сообщение в программе по умолчанию для отправки электронных писем
  • Сообщение (для ознакомления) (Mail Recipient for Review) — вполне интересный вариант. Перед отправкой для книги включается отслеживание изменений(Сервис(Tools)—Исправления(Track changes)). Можно воспользоваться этим методом, чтобы отправить получателю для внесения им изменений, а после отследить их(Сервис —Исправления —Выделить исправления(Highlight changes))
  • Сообщение (как вложение)(Mail Recipient as attachment) — создается сообщение в программе по умолчанию для отправки электронных писем, в которое вложением вкладывается активная книга целиком
  • По маршруту(Routing Recipient) — практически тоже самое, что и Сообщение (для ознакомления) (Mail Recipient for Review) с той разницей, что письмо с вложением пересылается как эстафета от одного получателя к другому. После этого так же можно отследить изменения, внесенные каждым пользователем
  • Папка Exchange(Exchange folder) — активная книга автоматически сохраняется в заданную папку общего сервера Microsoft Exchange. Доступ к этой книге будет открыт всем участникам рабочей группы
  • Факс пользователю службы факсов интернета(Fax) — отправляет содержимое книги по факсу указанным получателям. Для использования данной возможности должна быть установлена служба факсов
• Excel 2007: Кнопка Офис —Отправить(Send) —Сообщение(E-mail)
• Excel 2010: Файл(File) —Сохранить и отправить(Save & Send) —Отправить(Send Using E-mail)

Далее выбирается способ отправки:

• Как вложение(Send as attachment) — будет автоматически запущена почтовая программа по умолчанию и создано новое письмо, в которое уже будет вложен файл книги, из которой была вызвана команда
• Как ссылку(Send link) — доступно, только если файл находится на сетевом ресурсе. После нажатия будет создано новое письмо в почтовой программе по умолчанию, в тело которого будет вставлена ссылка на книгу
• Как PDF(Send as PDF) — файл будет автоматически сохранен в формате PDF, далее будет создано новое письмо в почтовой программе по умолчанию и файл PDF будет вставлен в письмо
• Как XPS(Send as XPS) — файл будет автоматически сохранен в формате PDF, далее будет создано новое письмо в почтовой программе по умолчанию и файл PDF будет вставлен в письмо
• Отправить как факс через интернет(Send as internet fax) — если у вас на ПК установлена служба работы с факсами и есть возможность отправлять и получать факсы на ПК — то данная команда отправит данные активного листа файла как факс

Простая отправка книги через VBA без Outlook

Описанные выше действия можно выполнить так же кодом(так же будет использоваться программа, установленная по умолчанию для отправки писем):

Sub SendMailStandart()
    ActiveWorkbook.SendMail "mail1@excel-vba.ru", "Тема письма"
End Sub

Также можно указать несколько получателей:

Sub SendMailStandart_MassRecipients()
    ActiveWorkbook.SendMail Array("mail1@excel-vba.ru", "mail2@excel-vba.ru"), "Тема письма"
End Sub

Внутри скобок Array можно в кавычках через запятую указать достаточное количество получателей.
Данный метод универсален, но работает только с активным файлом. Нельзя выбрать файл с диска и отправить как вложение. Кроме того, нельзя отправить более одного файла разом и указать текст письма.
Поэтому очень часто на форумах возникает вопрос как отправить письмо из Excel кодом с указанием темы, текста и вложения.
Есть несколько вариантов:

Отправить письмо через Outlook кодом VBA

Option Explicit
 
Sub Send_Mail()
    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
 
    Application.ScreenUpdating = False
    On Error Resume Next
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    'раскомментировать строку, если в Outlook несколько учетных записей и нужно подключиться к конкретной(только если Outlook закрыть)
    '   [параметры]: Session.Logon "имя профиля","пароль",[показывать окно выбора профиля], [запускать в новой сессии]
    'objOutlookApp.Session.Logon "profile","1234",False, True
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
 
    sTo = "AddressTo@mail.ru"    'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
    sSubject = "Автоотправка"    'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
    sBody = "Привет от Excel-VBA"    'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
    sAttachment = "C:TempКнига1.xls"    'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value)
 
    'создаем сообщение
    With objMail
        .To = sTo 'адрес получателя
        .CC = "" 'адрес для копии
        .BCC = "" 'адрес для скрытой копии
        .Subject = sSubject 'тема сообщения
        .Body = sBody 'текст сообщения
        '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.)
        'добавляем вложение, если файл по указанному пути существует(dir проверяет это)
        If sAttachment <> "" Then
            If Dir(sAttachment, 16) <> "" Then
                .Attachments.Add sAttachment 'просто вложение
                'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName
            End If
        End If
        .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
    End With
 
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub

Этот код отправляет одно письмо и одно вложение за раз. Но если несколько раз вызвать метод .Attachments.Add, то можно добавить еще файлы:

.Attachments.Add "C:TempКнига1.xlsx"
.Attachments.Add "C:TempКнига2.xlsx"
.Attachments.Add "C:DocumentsReport.rar"

Строка:

objOutlookApp.Session.Logon "user","1234",False, True

имеет особое значение. По сути она нужна только в тех случаях, когда в Outlook настроено несколько профилей(не путать с учетными записями) и запускать нужно от конкретного. Если профиль только один или не указан, то Outlook запускается с профилем по умолчанию. Для этого строку нужно записать без параметров(так же можно записать эту строку, если Outlook при попытке создания письма выдает ошибку профиля):

objOutlookApp.Session.Logon

Важно помнить: пути для файлов в качестве вложений должны содержать полный путь до файла, включая его имя и расширение: C:DocumentsReport.rar. При указании только имени Report.rar или пути без расширения (C:DocumentsReport) ошибки не будет, но вложения не будут помещены в сообщения и адресату отправится письмо без вложений.

Этот код создает сообщение, но есть маленький нюанс — если в Outlook настроено добавление подписей в новые сообщения — то созданные кодом VBA письма игнорирует эту настройку(особенность Outlook, так назовем). Поэтому, если необходимо отправлять письма с подписью, то ознакомьтесь со статьей: Вставить в письмо подпись из Outlook через VBA
В этой же статье можно посмотреть пример составления письма с форматированным текстом.

 
Отправить письма через Outlook с картинкой в теле письма

Sub Send_Mail_With_Picture()
    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String, sPicture As String
 
    Application.ScreenUpdating = False
    On Error Resume Next
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    'objOutlookApp.Session.Logon "user","1234",False, True
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
 
    sTo = "AddressTo@mail.ru"    'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
    sSubject = "Автоотправка"    'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
    sBody = "Привет от Excel-VBA"    'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
    sAttachment = "C:TempКнига1.xls"    'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value)
    sPicture = "C:ДокументыИзображенияExcel_vba_ru.png" 'если надо вставить в письмо картинку
    'создаем сообщение
    With objMail
        .To = sTo 'адрес получателя
        .CC = "" 'адрес для копии
        .BCC = "" 'адрес для скрытой копии
        .Subject = sSubject 'тема сообщения
'        .Body = sBody 'текст сообщения без форматирования
        .HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.)
        'чтобы картинка была видна внутри сообщения - надо её сначала добавить как вложение
        'если картинка по указанному пути существует(dir проверяет это)
        If Dir(sPicture, 16) <> "" Then
            If Dir(sPicture, 16) <> "" Then
                .Attachments.Add sPicture
                'теперь вставляем код картинки
                .HTMLBody = .HTMLBody & "<p>Картинка в письме</p>" & "<img src=cid:" & Replace(Dir(sPicture, 16), " ", "%20") & ">" ' & " height=240 width=180>"
            '" height=240 width=180>" - если нужны размеры картинки
            End If
        End If
        'добавляем вложение, если файл по указанному пути существует(dir проверяет это)
        If sAttachment <> "" Then        
            If Dir(sAttachment, 16) <> "" Then
                .Attachments.Add sAttachment 'просто вложение
            End If
        End If
        .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
    End With
 
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub

Этот код отправляет одно письмо и вставляет одну картинку. За это отвечает строка

"<img src=cid:" & Replace(Dir(sPicture, 16), " ", "%20") & ">"

Если картинку надо вложить с заранее указанными размерами, то строка будет выглядеть так:

"<img src=cid:" & Replace(Dir(sPicture, 16), " ", "%20") & " height=240 width=180>"
'height - высота
'width  - ширина

Если надо добавить несколько картинок, то метод .Attachments.Add sPicture надо будет вызвать столько раз, сколько картинок(для каждого свой путь к картинке).

Важно помнить: пути для картинок должны содержать полный путь до файла, включая его имя и расширение: C:ДокументыИзображенияExcel_vba_ru.png. При указании только имени Excel_vba_ru.png или пути без расширения (C:ДокументыИзображенияExcel_vba_ru) ошибки не будет, но картинка не будет вставлена, а вместо неё скорее всего будет текст «Ошибка загрузки картинки!» или пустой квадрат вместо реальной картинки.

 
Массовая рассылка писем по адресам

Так же можно сделать нечто вроде рассылки, организовав цикл по ячейкам. Предположим, что в столбце А записаны адреса, в столбце В тема, в столбце С текст сообщения, в столбце D путь к вложениям:

Тогда можно применить следующий код:

Sub Send_Mail_Mass()
    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
    Dim lr As Long, lLastR As Long
 
    Application.ScreenUpdating = False
    On Error Resume Next
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    'произошла ошибка создания объекта - выход
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
    'objOutlookApp.Session.Logon "user","1234",False, True
 
    lLastR = Cells(Rows.Count, 1).End(xlUp).Row
    'цикл от второй строки(начало данных с адресами) до последней ячейки таблицы
    For lr = 2 To lLastR
        Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
        'создаем сообщение
        With objMail
            .to = Cells(lr, 1).Value 'адрес получателя
            .Subject = Cells(lr, 2).Value 'тема сообщения
            .Body = Cells(lr, 3).Value 'текст сообщения
            'вложение(если ячейка не пустая и путь к файлу указан правильно)
            If Cells(lr, 4).Value <> "" Then   
                If Dir(Cells(lr, 4).Value, 16) <> "" Then
                    .Attachments.Add Cells(lr, 4).Value
                End If
            End If
            .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
        End With
    Next lr
 
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub

Скачать пример массовой рассылки:

  Массовая рассылка писем через Outlook.xls (60,0 KiB, 6 986 скачиваний)

При использовании этих кодов есть один недостаток: очень часто при программной отправке писем Outlook выдает окно с запросом подтверждения отправки. Сообщение может быть трех видов:

• Программа пытается получить доступ к адресам электронной почты, хранящимся в Outlook. Если вы этого не ожидаете, нажмите кнопку «Запретить» и проверьте наличие последних обновлений для антивирусной программы.
• Программа пытается отправить сообщение от вашего имени. Если вы этого не ожидаете, нажмите кнопку «Запретить» и проверьте наличие последних обновлений для антивирусной программы.
• Программа пытается выполнить действие, которое может привести к отправке сообщения от вашего имени. Если вы этого не ожидаете, нажмите кнопку «Запретить» и проверьте наличие последних обновлений для антивирусной программы

Чтобы при программной отправке данных сообщений не появлялось, в версиях Outlook, начиная с 2007 можно отключить его настройками безопасности:

• Outlook 2007: Меню—Параметры—Центр управления безопасностью—Программный доступ-установить Никогда не предупреждать о подозрительной активности (не рекомендуется)
• Outlook 2010 и выше: Файл—Параметры—Центр управления безопасностью—Программный доступ-установить Никогда не предупреждать о подозрительной активности (не рекомендуется)

ВАЖНО: Если компьютер управляется администратором Microsoft Exchange или Microsoft Windows Active Directory Domain Services и администратором в качестве параметров по умолчанию установлен запрет на внесение изменений в параметры безопасности пользователями, возможность изменения данных настроек безопасности программного доступа будет недоступна.

Важно: сам код рассылки не имеет никаких ограничений по числу отправляемых сообщений. Но различные почтовые серверы могут устанавливать свои лимиты. Например, Gmail и Yandex могут заблокировать email, с которого ведется рассылка, если общее количество отправленных сообщений превышает 100 штук в день. Поэтому производить важные массовые рассылки рекомендуется с собственного SMTP-сервера.

Но так же при отправке файлов и писем часто необходимо не привязываться к конкретной почтовой программе. Ведь далеко не все ставят Outlook. Многие используют иные почтовые программы, например TheBat.

Отправка сообщения без использования Outlook — используем CDO

Option Explicit
 
Sub Send_Mail()
    Const CDO_Cnf = "http://schemas.microsoft.com/cdo/configuration/"
    Dim oCDOCnf As Object, oCDOMsg As Object
    Dim SMTPserver As String, sUsername As String, sPass As String, sMsg As String
    Dim sTo As String, sFrom As String, sSubject As String, sBody As String, sAttachment As String
    On Error Resume Next
    'sFrom – как правило совпадает с sUsername
    SMTPserver = "smtp.yandex.ru"    ' SMTPServer: для Mail.ru "smtp.mail.ru"; для Яндекса "smtp.yandex.ru"; для Рамблера "mail.rambler.ru"
    sUsername = "YourMail@mail.ru"    ' Учетная запись на сервере
    sPass = "1234"    ' Пароль к почтовому аккаунту
 
    If Len(SMTPserver) = 0 Then MsgBox "Не указан SMTP сервер", vbInformation, "www.Excel-VBA.ru": Exit Sub
    If Len(sUsername) = 0 Then MsgBox "Не указана учетная запись", vbInformation, "www.Excel-VBA.ru": Exit Sub
    If Len(sPass) = 0 Then MsgBox "Не указан пароль", vbInformation, "www.Excel-VBA.ru": Exit Sub
 
    sTo = "AddressTo@mail.ru"    'Кому
    sFrom = "YourMail@yandex.ru"    'От кого
    sSubject = "Автоотправка"    'Тема письма
    sBody = "Привет от Excel-VBA"    'Текст письма
    sAttachment = "C:/Temp/Книга1.xls"    'Вложение(полный путь к файлу)
 
    'Назначаем конфигурацию CDO
    Set oCDOCnf = CreateObject("CDO.Configuration")
    With oCDOCnf.Fields
        .Item(CDO_Cnf & "sendusing") = 2
        .Item(CDO_Cnf & "smtpauthenticate") = 1
        .Item(CDO_Cnf & "smtpserver") = SMTPserver
        'если необходимо указать SSL
        '.Item(CDO_Cnf & "smtpserverport") = 465 'для Яндекса и Gmail 465
        '.Item(CDO_Cnf & "smtpusessl") = True
        '=====================================
        .Item(CDO_Cnf & "sendusername") = sUsername
        .Item(CDO_Cnf & "sendpassword") = sPass
        .Update
    End With
    'Создаем сообщение
    Set oCDOMsg = CreateObject("CDO.Message")
    With oCDOMsg
        Set .Configuration = oCDOCnf
        .BodyPart.Charset = "koi8-r"
        .From = sFrom
        .To = sTo
        .Subject = sSubject
        .TextBody = sBody
        'Проверка наличия файла по указанному пути
        If Len(sAttachment) > 0 Then
            If Dir(sAttachment, 16) <> "" Then
                .AddAttachment sAttachment
            End If
        End If
        .Send
    End With
 
    Select Case Err.Number
    Case -2147220973: sMsg = "Нет доступа к Интернет"
    Case -2147220975: sMsg = "Отказ сервера SMTP"
    Case 0: sMsg = "Письмо отправлено"
    Case Else: sMsg = "Ошибка номер: " & Err.Number & vbNewline & "Описание ошибки: " & Err.Description
    End Select
    MsgBox sMsg, vbInformation, "www.Excel-VBA.ru"
    Set oCDOMsg = Nothing: Set oCDOCnf = Nothing
End Sub

Данный код отправляет письмо, используя объект CDO(Collaboration Data Objects — присутствует во всех версиях Windows) и от имени Вашей учетной записи(либо Яндекс, либо Мэйл, либо Рамблер либо др.).

• SMTPserver — Каждый из приведенных выше сервисов имеет свой сервер для отправки сообщений(его можно посмотреть на сайте сервиса). В комментариях к коду я написал три самых распространенных, но если Вы используете какой-то другой, то просто посмотрите на его сайте настройки для Outlook и отыщите тот параметр, который отвечает за SMTPserver.
• sUsername — это Ваш логин для входа в почтовый сервис. Думаю тут все понятно. Единственный момент — обязательно указывать e-mail именно в полном виде — YourMail@mail.ru, даже если для входа на сервис через браузер Вы используете только первую часть записи(YourMail). Если необходимо подставить в качестве отправителя псевдоним(чтобы получатель видел не просто адрес, а ассоциированное имя учетной записи), то указывать надо именно в формате псевдонима:

  sFrom = "Excel-vba <YourMail@yandex.ru>"

  Excel-vba — и есть псевдоним. А сам адрес должен указываться между знаками <>

• sPass — пароль доступа к Вашей учетной записи, который Вы используете для входа в почту.

Это основные моменты. Поля Кому(sTo), От кого(sFrom),Тема письма(sSubject), Текст письма(sBody) и Вложение(sAttachment) думаю не нуждаются в расшифровке.
Так же стоит учесть пару важных моментов: если на почтовом сервере используется шифрование, то необходимо раскомментировать(убрать знак апострофа) эти строки:

.Item(CDO_Cnf & "smtpserverport") = 465
.Item(CDO_Cnf & "smtpusessl")

Иначе вместо отправки письма получим ошибку «Отказ сервера SMTP». Серверы Яндекс и Gmail требуют шифрования, а значит для них указанные выше строки должны быть активированы(т.е. раскомментированы). Номер порта указывается в описании настроек сервера и для каждого сервера может быть своим, поэтому если с указанием приведенного в коде порта(«smtpserverport») письмо не отправляется — необходимо зайти в настройки почтового сервера и убедиться в правильности указания номера порта.

Чтобы использовать данный код вы можете либо просто скопировать его прямо со страницы, либо скачать файл. В файле программа немного упрощена к использованию — в ячейки листа вам необходимо будет внести поля: Кому(sTo), От кого(sFrom),Тема письма(sSubject), Текст письма(sBody) и Вложение(sAttachment) и выбрать SMTPserver. SMTPserver выбирается из выпадающего списка. Сам список является динамическим и расположен на листе «Settinngs«. Там же расположены поля Учетной записи и Пароль, которые автоматически подставляются в необходимые поля на листе «Отправка«. Т.к. список динамический Вы можете просто добавлять к уже имеющимся новые сервисы и потом просто выбирать их из списка. Так же в файле есть еще одна возможность — выбрать файл. Для этого надо просто нажать на кнопку и выбрать файл.

Скачать пример:

  Массовая рассылка писем через CDO — без Outlook.xls (64,0 KiB, 7 544 скачиваний)

Ввиду все более участившихся вопросов о том, как добавить к тексту письма картинку именно через CDO — описываю как это можно сделать. Я приведу лишь самый главный кусок кода — создание непосредственно сообщения. Весь остальной код остается таким же, как приведен выше.

With oCDOMsg
    Set .Configuration = oCDOCnf
    .From = sFrom
    .BodyPart.Charset = "windows-1251"
    .To = sTo
    .Subject = sSubject
    Set objbp = oCDOMsg.AddRelatedBodyPart("C:ДокументыИзображения11.jpg", "11.jpg", 1)
    objbp.Fields.Item("urn:schemas:mailheader:Content-ID") = "<11.jpg>"
    objbp.Fields.Update
    If Len(sAttachment) > 0 Then
        If Dir(sAttachment, 16) <> "" Then
            .AddAttachment sAttachment
        End If
    End If
    'для вложения картинки письмо лучше формировать в формате HTML
    .HTMLBody = "<img src=""11.jpg""><br />" & sBody
    .Send
End With

Самый главный момент:
AddRelatedBodyPart

C:ДокументыИзображения11.jpg — указывается полный путь к файлу картинки на компьютере, включая расширение файла.
11.jpg — указывается имя картинки с расширением. Это имя будет использовано внутри письма и именно его необходимо будет указать дальше в «urn:schemas:mailheader:Content-ID». И указывать обязательно в треугольных скобках: «<11.jpg>»
внутри же самого письма в том месте, где должна отображаться картинки надо записать:

в приведенном выше коде картинка вставляется в самом начале письма и после неё так же добавляется перенос на новую строку при помощи тэга

Также см.:
Отправка листа/книги по почте
Вставить в письмо подпись из Outlook через VBA
Вставить в письмо Outlook таблицу Excel с форматированием
Сохранить вложения из Outlook в указанную папку
Как отправить письмо от другой учетной записи Outlook

Статья помогла? Поделись ссылкой с друзьями!

    Видеоуроки

Поиск по меткам



Access
apple watch
Multex
Power Query и Power BI
VBA управление кодами
Бесплатные надстройки
Дата и время
Записки
ИП
Надстройки
Печать
Политика Конфиденциальности
Почта
Программы
Работа с приложениями
Разработка приложений
Росстат
Тренинги и вебинары
Финансовые
Форматирование
Функции Excel
акции MulTEx
ссылки
статистика

Иногда, в процессе трудовой деятельности, приходится периодически отправлять различного рода сообщения однотипного характера по списку рассылки. Например, напоминание о предоставлении показаний приборов от разных абонентов, необходимо запрашивать каждое 25-тое число месяца. Это очень муторно и требует каждый раз создавать сообщение, вспоминать адреса электронной почты абонентов, набирать текст сообщения, тему. В принципе это занимает не так много времени, но зачем отвлекаться на то, что можно сделать автоматически использую автоматическую рассылку писем из Excel через Outlook?

В статье «Отправить почту через Excel с помощью макроса» мы разработали функцию, которая создает новое сообщение Outlook из экселя:


Function CreateNewMail(email As String, tema As String, text As String, Optional put_file As String)
'' Создать объект Outlook
Set Mail = CreateObject("outlook.application")
'' Создать новое сообщение
With Mail.CreateItem(olMailItem)
.To = email'' адрес электронной почты
.body = text'' текст сообщения
.Subject = tema '' тема сообщения
.Display '' показать окно сообщения перед отправкой
'' прикрепить файл (при необходимости)
If Len(put_file) <> 0 Then .Attachments.Add put_file
End With
End Function


Для автоматической рассылки писем из excel через outlook необходимо данную функцию доработать, удалив из оператора With строку .Display чтобы окно созданного сообщение не отображалось лишний раз не отвлекая, от более важных дел. А также в конце оператора With добавив строку .Send. Соответственно получится функция следующего вида:


Function CreateNewMail(email As String, tema As String, text As String, Optional put_file As String)
'' Создать объект Outlook
Set Mail = CreateObject("outlook.application")
'' Создать новое сообщение
With Mail.CreateItem(olMailItem)
.To = email'' адрес электронной почты
.body = text'' текст сообщения
.Subject = tema '' тема сообщения
'' прикрепить файл (при необходимости)
If Len(put_file) <> 0 Then .Attachments.Add put_file
.Send '' отправить сообщение
End With
End Function


Теперь необходимо объявить глобальную переменную Vremya для запуска и остановки таймера выполнения макроса рассылки писем из excel через outlook.


Public Vremya '' объявляем глобальную переменную времени, в которое необходимо выполнить макрос


Создаем макрос рассылки писем:


'' отправка сообщения в указанное время
Sub otMessage()
Vremya = Now + TimeSerial(0, 1, 0)'' к текущему времени прибавить одну минуту
Application.OnTime Vremya, "newMessage"'' выполнять отправку сообщения через каждую минуту
End Sub


Переменная Vremya может иметь любое значение вида «15.05.2020 13:23:14». Присваиваем ей значение текущего времени (получая его вызвав встроенную в vba функцию Now) прибавляя к нему одну минуту используя TimeSirial, синтаксис которого приведен ниже:


TimeSerial(ЧАСЫ, МИНУТЫ, СЕКУНДЫ)


На итог переменная Vremya равна текущей дате и времени плюс одна минута.

Дальше используя таймер Application.OnTime ЧЕРЕЗ_СКОЛЬКО_ЗАПУСТИТЬ_МАКРОС, ФУНКЦИЯ запускаем выполнение функции newMessage(). Здесь вводится дополнительная функция newMessage() ввиду невозможности передачи атрибутов используя OnTime.

Сама же функция newMessage() представляет собой следующее:


Function newMessage()
'' вызываем функцию (с передачей необходимых параметров) отправки нового сообщения
Message = CreateNewMail("planero.ru@yandex.ru;", "текст сообщения", "тема сообщения")
'' прекратить отправку сообщений через каждую минуту
Application.OnTime Vremya, "newMessage", , False
End Function


Первым делом вызываем функцию CreateNewMail с передачей ей необходимых атрибутов: адреса электронной почты, текста сообщения, темы сообщения. И после выполнения автоматической отправки письма останавливаем ранее запущенный таймер OnTime в процедуре otMessage.

В итоге получилось реализовать в vba автоматическую рассылку писем из excel через outlook, которая избавит от необходимости отправки однотипно-повторяющихся сообщений. А изменив переменную Vremya под себя, можно сделать рассылку в нужное вам время.

Сам макрос можно написать самому, а можно скачать уже готовый вариант по ссылке.

Комментарии 2

Отправка книги или листа по электронной почте

Если вам часто приходится рассылать определенные книги или листы по электронной почте, то вы должны были заметить, что процедуру эту быстрой не назовешь. Если делать ее «классически», то надо:

• открыть почтовую программу (например Outlook)
• создать новое сообщение
• вбить туда адрес, тему и текст
• прикрепить к сообщению файл (не забыть!)
• нажать кнопку Отправить

На самом деле почту можно легко отправлять прямо из Excel кучей разных способов. Поехали…

Способ 1. Встроенная отправка

Если у вас еще старый добрый Excel 2003, то все просто. Открываете нужную книгу/лист и выбираете в меню Файл — Отправить — Сообщение (File — Send To — Mail Recipient). Откроется окошко, в котором можно выбрать один из двух вариантов отправки:

В первом случае текущая книга будет добавлена в сообщение как вложение, во втором — содержимое текущего листа попадет прямо в текст сообщения как текстовая таблица (без формул).

Кроме этого в меню Файл — Отправить (File — Send To) есть еще несколько более экзотических вариантов отправки:

• Сообщение (для ознакомления) (Mail Recipient for Review) — отправляется вся книга целиком и при этом для нее включается отслеживание изменений, т.е. начинает явно фиксироваться — кто, когда и в каких ячейках какие изменения производил. Отобразить внесенные изменения потом можно в меню Сервис — Исправления — Выделить исправления (Tools — Track changes — Highlight changes) или на вкладке Рецензирование — Исправления (Reveiw — Track Changes) Выглядеть это будет примерно так:
  
  

  Цветные рамочки помечают изменения, внесенные в документ (для каждого пользователя — свой цвет). При наведении мыши всплывает похожее на примечание окошко с подробным описанием кто, что и когда изменил в этой ячейке. Весьма удобно для рецензирования документов, когда, например, вы правите отчет своих подчиненных или шеф правит ваш.

• По маршруту (Routing Recipient) — сообщение, куда будет вложена ваша книга, отправится по цепочке получателей, каждый из которых автоматически будет пересылать его дальше, как эстафетную палочку. При желании можно задать, чтобы в конце цепочки сообщение вернулось к вам обратно. Можно включить режим отслеживания изменений, чтобы видеть правки, внесенный каждым человеком в цепочке.

В новых Excel 2007/2010 ситуация немного другая. В этих версиях для отправки книги по почте нужно выбрать кнопку Офис (Office Button) или вкладку Файл (File) и команду Отправить (Send). Далее, пользователю предлагается набор вариантов отправки:

Обратите внимание на то, что в новых версиях исчезла возможность отправки отдельного листа книги, вставленного в тело письма — как это было в Excel 2003 и старше. Осталась только возможность отправить весь файл целиком. Зато появилась полезная возможность отправлять в известном формате PDF и менее известном XPS (аналог PDF, но не требует Acrobat Reader для чтения — открывается прямо в Internet Explorer). Команду отправки книги для ознакомления можно вытащить как дополнительную кнопку на панель быстрого доступа через Файл — Параметры — Панель быстрого доступа — Все команды — Отправить на проверку (File — Options — Quick Access Toolbar — All Comands — Send for Review).

Способ 2. Простые макросы для отправки

Отправка макросом гораздо проще. Открываем редактор Visual Basic через меню Сервис — Макрос — Редактор Visual Basic (Tools — Macro — Visual Basic Editor), вставляем новый модуль в меню Insert — Module и копируем туда текст этих двух макросов:

Sub SendWorkbook()
    ActiveWorkbook.SendMail Recipients:="vasya@pupkin.com", Subject:="Лови файлик"
End Sub

Sub SendSheet()
    ThisWorkbook.Sheets("Лист1").Copy
    With ActiveWorkbook
        .SendMail Recipients:="vasya@pupkin.com", Subject:="Лови файлик"
        .Close SaveChanges:=False
    End With
End Sub

После этого скопированные макросы можно запустить в меню Сервис — Макрос — Макросы (Tools — Macro — Macros). SendWorkbook отправляет на заданный адрес всю текущую книгу, а SendSheet — Лист1 как вложение.

При запуске макроса Excel будет обращаться к Outlook, что вызовет появление вот такого сообщения безопасности на экране:

Дождитесь, пока кнопка Разрешить станет активной и нажмите ее, чтобы подтвердить свою отправку. После этого созданные автоматически сообщения будут помещены в папку Исходящие и отправятся получателям при первом запуске Outlook или, если он у вас запущен, непосредственно сразу же.

Способ 3. Универсальный макрос

А если хочется отправлять не текущую книгу, а любой другой файл? И текст сообщения тоже неплохо было бы задать! Предыдущие макросы здесь не помогут, поскольку ограничены возможностями самого Excel, но можно создать макрос, который будет из Excel’я управлять Outlook’ом — создавать и заполнять окно нового сообщения и отправлять его. Макрос выглядит так:

Sub SendMail()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")   'запускаем Outlook в скрытом режиме
    OutApp.Session.Logon      
    On Error GoTo cleanup  'если не запустился - выходим 
    Set OutMail = OutApp.CreateItem(0)   'создаем новое сообщение
    On Error Resume Next
    'заполняем поля сообщения
    With OutMail
        .To = Range("A1").Value
        .Subject = Range("A2").Value
        .Body = Range("A3").Value
        .Attachments.Add Range("A4").Value
        'команду Send можно заменить на Display, чтобы посмотреть сообщение перед отправкой 
        .Send
    End With

    On Error GoTo 0
    Set OutMail = Nothing

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Адрес, тема, текст сообщения и путь к вложенному файлу должны быть в ячейках A1:A4 текущего листа.

Ссылки по теме

• Групповая рассылка почтовых сообщений из Excel с помощью надстройки PLEX
• Макросы для отправки почты из Excel через Lotus Notes от Dennis Wallentin
• Что такое макросы, куда вставлять код макроса на Visual Basic
• Создание писем с помощью функции ГИПЕРССЫЛКА

Время на прочтение
6 мин

Количество просмотров 23K

В этой статье я бы хотел поделиться опытом автоматизации офисной, рутинной задачи по отправке сообщений группе клиентов.
Итак, собственно, в чем вопрос: необходимо отправить электронные письма с вложением нескольким десяткам клиентам. При этом в поле получателя должен быть только один адрес, т.е. клиенты друг о друге не должны знать. Кроме того, не допускается установка дополнительного программного обеспечения, типа MaxBulk Mailer и ему подобного. В нашем распоряжении есть только Microsoft Office, а в данном конкретном случае — Microsoft Office 2013.

Я описываю, на мой взгляд, самый вариант – без применения шаблонов, черновиков и форматирования. Для наших целей потребуется Outlook (переходим в редактор VBA и добавляем модуль, еще включаем «Microsoft Excel 15.0 Object Library» в Tools > References), текстовый файл со списком адресатов по принципу «одна строка-один адрес», текстовый файл с телом письма и файлы, которые будем отправлять в качестве вложения.
Общий алгоритм таков: указываем данные для полей и генерируем письма, перебирая в цикле получателей.
Сразу отмечу, что данный пример не является неким доведенным до совершенства кодом, работающим с максимальной эффективностью при минимальных размерах. Но он работает и справляется с заявленным функционалом. Собственно, мне было просто лень отправлять вручную несколько десятков писем и я написал эту программу, а потом решил ей поделиться. Если кому-то интересно, тот может улучшать код сколько душе угодно.
VBA, по умолчанию, не требует четкого объявления переменных и их типов. В принципе, можно вообще обойтись без этого. Поэтому некоторые переменные в «эпизодических ролях» не описаны в конструкции с Dim.
Итак, сначала запрашиваем тему письма с реализацией проверки на отмену действия.

TxtSubj = InputBox("Тема письма", "Рассылка")
If Len(Trim(TxtSubj)) = 0 Then
    Exit Sub
End If

Теперь очередь за файлами с адресами и текстом письма. Вот здесь возник нюанс. Как вызвать диалог выбора файла? О жестком прописывании пути я не хочу и думать. Так что приходится что-то придумывать. Многими используемый вариант с Application.GetOpenFilename не пройдет, так как в Outlook нет такого метода. Использовать API пробовал. Вариант с «Private Declare PtrSafe Function GetOpenFileName Lib „comdlg32.dll“…» не сработал (PtrSafe из-за того, что система Win7, х64). Ошибок не выдавал, но при вызове ничего не появлялось. Решения в Интернете не нашел. Если кто подскажет решение – буду благодарен. Таким образом, пришлось пойти в обход с применением объекта Excel.Application.

Dim xlApp As New Excel.Application
Set fd = xlApp.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.Title = "Файл с текстом письма"
.Filters.Add "Текстовый файл", "*.txt", 1
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
Path2Body = vrtSelectedItem
Next vrtSelectedItem
Else
    Exit Sub
End If
End With
Set fd = Nothing

Set fd = xlApp.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.Title = "Файл со списком адресов"
.Filters.Add "Текстовый файл", "*.txt", 1
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
Path2To = vrtSelectedItem
Next vrtSelectedItem
Else
    Exit Sub
End If
End With
Set fd = Nothing

А теперь и вложения. Тут я использовал динамический массив и возможность множественного выбора диалога.

Set fd = xlApp.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = True
.Title = "Файлы, прилагаемые к письму"
.Filters.Add "Все файлы", "*.*", 1
If .Show = -1 Then
    i = 0
    ReDim Preserve Path2Att(i)
    For Each vrtSelectedItem In .SelectedItems
        Path2Att(i) = vrtSelectedItem
        i = i + 1
        ReDim Preserve Path2Att(i)
    Next vrtSelectedItem
Else
    Exit Sub
End If
End With
Set fd = Nothing

Каждый раз я создавал и удалял объект fd из-за того, что это сделать проще, чем заниматься его чисткой перед последующим вызовом.
Для получения данных из текстовых файлов пришлось использовать пару дополнительных функций. Вызываются они таким образом:

txtBody = ReadTXTfile(Path2Body)
Item2To = ReadTXTfile2Arr(Path2To)

Function ReadTXTfile(ByVal filename As String) As String
    Set FSO = CreateObject("scripting.filesystemobject")
    Set ts = FSO.OpenTextFile(filename, 1, True): ReadTXTfile = ts.ReadAll: ts.Close
    Set ts = Nothing: Set FSO = Nothing
End Function
Function ReadTXTfile2Arr(ByVal filename As String) As Variant
Const OpenFileForReading = 1
Const OpenFileForWriting = 2
Const OpenFileForAppending = 8
Const vbSplitAll = -1
 
Dim S As Variant

Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSOFile = FSO.GetFile(filename)
Set TextStream = FSOFile.OpenAsTextStream(OpenFileForReading)
Do While Not TextStream.AtEndOfStream
   S = S & TextStream.ReadLine & vbNewLine
Loop
TextStream.Close
ReadTXTfile2Arr = Split(S, vbNewLine, vbSplitAll, vbTextCompare)
Set TextStream = Nothing
Set FSOFile = Nothing
Set FSO = Nothing
End Function

С целью отладки я вставил такой код
‘Контроль за данными

'Debug.Print "Адреса получателя"
'Debug.Print "-----------------"
'For i = 0 To UBound(Item2To) - 1
'    Debug.Print Item2To(i)
'Next i
'Debug.Print "Прилагаемые файлы"
'Debug.Print "-----------------"
'For i = 0 To UBound(Path2Att) - 1
'    Debug.Print Path2Att(i)
'Next i
'Debug.Print "Тема письма"
'Debug.Print "-----------"
'Debug.Print TxtSubj
'Debug.Print "Тело письма"
'Debug.Print "-----------"
'Debug.Print txtBody

Как видно, он сейчас закомментирован, но позволяет понять где что лежит.
Теперь небольшая по размеру, но самая важная часть – генерация писем.

Dim olMailMessage As Outlook.MailItem
For i = 0 To UBound(Item2To) - 1
    Set olMailMessage = Application.CreateItem(olMailItem)
    With olMailMessage
        DoEvents
        .To = Item2To(i)
        .Subject = TxtSubj
        .Body = txtBody
        For k = 0 To UBound(Path2Att) - 1
            .Attachments.Add Path2Att(k), olByValue
            DoEvents
        Next k
        .Send
    End With
    Set olMailMessage = Nothing
Next i

При желании, метод .Send можно заменить на .Save. Тогда созданные письма окажутся в папке «Черновики».

Здесь полный код модуля «как есть».

Attribute VB_Name = "Module"

Function ReadTXTfile(ByVal filename As String) As String
    Set FSO = CreateObject("scripting.filesystemobject")
    Set ts = FSO.OpenTextFile(filename, 1, True): ReadTXTfile = ts.ReadAll: ts.Close
    Set ts = Nothing: Set FSO = Nothing
End Function

Function ReadTXTfile2Arr(ByVal filename As String) As Variant
Const OpenFileForReading = 1
Const OpenFileForWriting = 2
Const OpenFileForAppending = 8
Const vbSplitAll = -1
Dim S As Variant
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSOFile = FSO.GetFile(filename)
Set TextStream = FSOFile.OpenAsTextStream(OpenFileForReading)
Do While Not TextStream.AtEndOfStream
   S = S & TextStream.ReadLine & vbNewLine
Loop
TextStream.Close
ReadTXTfile2Arr = Split(S, vbNewLine, vbSplitAll, vbTextCompare)
Set TextStream = Nothing
Set FSOFile = Nothing
Set FSO = Nothing
End Function

Public Sub Autosender()
'требуется текстовый файл с перечнем адресов (каждый с новой строки),
'текстовый файл с телом письма
'и попросит выбрать вложение (мультивыбор доступен)
Dim Path2Body As String
Dim Path2To As String
Dim Path2Att() As String
Dim Item2To() As String
Dim TxtSubj As String
Dim txtBody As Variant
Dim i
Dim k
Dim vrtSelectedItem As Variant
Dim fd As FileDialog
Dim olMailMessage As Outlook.MailItem
Dim xlApp As New Excel.Application
GenerateThis = False
TxtSubj = InputBox("Тема письма", "Рассылка")
If Len(Trim(TxtSubj)) = 0 Then
    Exit Sub
End If
Set fd = xlApp.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.Title = "Файл с текстом письма"
.Filters.Add "Текстовый файл", "*.txt", 1
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
Path2Body = vrtSelectedItem
Next vrtSelectedItem
Else
    Exit Sub
End If
End With
Set fd = Nothing
Set fd = xlApp.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.Title = "Файл со списком адресов"
.Filters.Add "Текстовый файл", "*.txt", 1
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
Path2To = vrtSelectedItem
Next vrtSelectedItem
Else
    Exit Sub
End If
End With
Set fd = Nothing
Set fd = xlApp.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = True
.Title = "Файлы, прилагаемые к письму"
.Filters.Add "Все файлы", "*.*", 1
If .Show = -1 Then
    i = 0
    ReDim Preserve Path2Att(i)
    For Each vrtSelectedItem In .SelectedItems
        Path2Att(i) = vrtSelectedItem
        i = i + 1
        ReDim Preserve Path2Att(i)
    Next vrtSelectedItem
Else
    Exit Sub
End If
End With
Set fd = Nothing
Set xlApp = Nothing
txtBody = ReadTXTfile(Path2Body)
Item2To = ReadTXTfile2Arr(Path2To)
DoEvents
'Контроль за данными
'Debug.Print "Адреса получателя"
'Debug.Print "-----------------"
'For i = 0 To UBound(Item2To) - 1
'    Debug.Print Item2To(i)
'Next i
'Debug.Print "Прилагаемые файлы"
'Debug.Print "-----------------"
'For i = 0 To UBound(Path2Att) - 1
'    Debug.Print Path2Att(i)
'Next i
'Debug.Print "Тема письма"
'Debug.Print "-----------"
'Debug.Print TxtSubj
'Debug.Print "Тело письма"
'Debug.Print "-----------"
'Debug.Print txtBody
For i = 0 To UBound(Item2To) - 1
    Set olMailMessage = Application.CreateItem(olMailItem)
    With olMailMessage
        DoEvents
        .To = Item2To(i)
        .Subject = TxtSubj
        .Body = txtBody
        For k = 0 To UBound(Path2Att) - 1
            .Attachments.Add Path2Att(k), olByValue
            DoEvents
        Next k
        .Send
    End With
    Set olMailMessage = Nothing
Next i
MsgBox "Отправлено.", vbInformation + vbOKOnly, "Рассылка"
End Sub

В данном примере реализована возможность отправки простых писем. Если необходимо расширить возможности, например сделать текст форматированным, то двигаться следует в направлении Outlook.MailItem > GetInspector > WordEditor. Это, мягко говоря, усложняет код, но позволит использовать в качестве источника текста письма форматированный документ Word.
Можно также добавить обработку «преднамеренного» отсутствия каких-либо составляющих письма. Например, реализовать отправку без темы, текста или вложений. Сейчас отказ от одного из этих элементов приведет к прерыванию процедуры.
Этот код, теоретически, должен работать также и в более ранних версиях Microsoft Office. Поменяется только ссылка на библиотеку Excel.