Возникла задача организации рассылки писем по списку e-mail пользователей в Excel. В каждом письме будут содержаться некоторые данные, индивидуальные для каждого пользователя, и приложен персональный файл. В этой статье, мы рассмотрим, как использовать Outlook для автоматической рассылки писем по списку из Excel с помощью VBA макроса или PowerShell
Допустим, у нас есть Excel файл, содержащий следующие столбцы:
Email пользователя | ФИО | Время последней смены пароля | Статус учетной записи
В рамках моей задачи нужно каждому пользователю из списка отправить письмо вида:
Тело письма: Уважаемый %FullUsername%
Ваша учетная запись в домене winitpro.ru — %status%
Время последней смены пароля: %pwdchange%
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.
Если вам нужно отправить письмо от имени другого пользователя или общего почтового ящика, нужно предоставить на него права SendAs/Sent on behalf (в случае использования Exchange) и добавить в скрипт строку (перед olMailItm.Send).
olMailItm.SentOnBehalfOfName = "yoursecondemail@domaincom"
Отправить письмо из 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:\PS\user_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 файла скрипт генерирует тему и текст письма и прикрепляет файл. Затем выполняется отправка письма.
Полезная статья.
Но функционал рассылки есть из коробки и без макроса http://telegra.ph/Formirovanie-i-rassylka-odnotipnyh-dokumentov-Word—Excel-10-19
Добрый вечер !
Полезный макрос, а как можно вложить файл?
Подскажите.
Для прикрепления файла, код формирования письма нужно поменять на такой:
olMailItm.Body = strBody
olMailItm .Attachments.Add ("C:\Users\Desktop\send.xls")
olMailItm.Send
Лучше скрипт сделать на контроллере домена например, или любом другом сервере, который будет опрашивать нужную ОУшку, на предмет время смены пароля, и отправлять если нужно письмо. Задание на выполнение каждый день этого скрипта.
Еще можно на логон пользователя сделать скрипт с проверкой, и вывести окошко при входе что необходимо сменить пароль, чтобы даже не заглядывая в почту человек видел, что до смены пароля например 3 дня.
Тут все верно, excel тут в принципе не нужен, все это гораздо проще можно и на PoSh реализовать. Но тут задача не о рассылке писем с данными об учетках в AD. Это просто пример. 🙂
Цель была — показать пример автоматизации почтовой рассылки по email адресам в xls с подстановкой данных из столбцов.
Как сделать что бы в письме узазывалась ссылка на файл ?
Сменить текст письма на HTML
olMailItm.BodyFormat = 2
И добавить в Body строку со ссылкой. Как-то так:
strBody = strBody & "[a href="\\srv1\public\main.docx"]Ссылка на файл[/a]"
ЗЫ. Заменить квадратные кавычки на теги < и >
Доброго времени суток, столкнулся с проблемой, есть 2000 адресов и outlook привязанный к яндексу, как разослать по 3 письма с вложениями (шаблон сохранен) каждые 5 минуты чтоб адреса брались следующие по списку?
Вы не разошлете, если письма будут одинаковые. Яндекс заблокирует отправку на 300-м письме — проверено мной лично экспериментальным путем. Для рассылки большого количества одинаковых писем используйте специализированные сервисы.
Если не сложно укажите какие сервисы лучше использовать?
Лично я использую Mailchimp
А из российских есть, например sendpulse
Спасибо большое за совет.
_https://yandex.ru/support/mail/web/spam.html
Добрый день! А возможно ли сделать, чтобы подпись с Outlook тоже подхватывалась и была в письме?
Можно просто добавить в письмо HTML код подписи:
Извините, немного не понял куда его добавлять, письмо же формируется в макросе из этой темы..
Смысл в том, чтобы HTML код с вашей подписью вставить прямо в код макроса. Таким образом в теле письма кроме данных будет отображаться ваша подпись.
Добрый день! VBA код ругается на такую строчку
strSign="С уважением" </font> & _
"Андрей Иванов"
strBody = strBody & strSign & vbCrLf
Конкретно на аперандекс и символ подчеркивания (& _). Подскажите что не так?
strBody = Cells(4, 2).Value ‘ тело письма
strSign = «С Уважением </font>» & «Антон»
mailFrom = Cells(5, 2).Value ‘ от кого (не работает пока)
fstStroka = Cells(6, 2).Value ‘ начало для отправки (номер строки)
numName = Cells(7, 2).Value ‘ Схема имени файла на отправку
On Error GoTo dbg
Set olApp = CreateObject(«Outlook.Application») ‘ создаем новый объект типа Outlook
For iCounter = fstStroka To WorksheetFunction.CountA(Range(Cells(fstStroka, 1), Cells(100, 1))) + fstStroka — 1
‘ создаем новый элемент (письмо) в Outlook
Set olMailItm = olApp.CreateItem(0)
useremail = Cells(iCounter, 1).Value ‘ кому
inputfilename = Cells(iCounter, 2).Value ‘ Город Бренд
olMailItm.To = useremail ‘ кому
‘olMailItm.From = mymail ‘ от кого — НЕ РАБОТАЕТ!!! — смени имя в OUTLOOK по умолчанию
olMailItm.Subject = strSubj ‘ тема письма
olMailItm.BodyFormat = 2 ‘ 1 — текстовый формат письма, 2 — HTML формат
olMailItm.Body = inputfilename & vbCrLf & strBody & strSign ‘ тело письма
strSign = "С Уважением </font>" & "Кутькин Антон"
Коллеги, а как сделать, чтобы письмо создавалось, но не отправлялось в автомате, а показывалось после создания — чтобы можно было его подправить или добавить адресантов?
пробовал ставить .Display взамен .Send — вообще ничего не отображается
Наверно лучше сохранить эти письма в черновиках Outlook.
Вместо
olMailItm.Send
используйте
olMailItm.Save
olMailItm.Close
Потом уже запускаете Outlook, проверяете черновики (Drafts) и отправляете по очереди.
Здравствуйте,
выдает что Argument is not optional.
Так же хотелось бы узнать как сделать так что б vba читал данные со второго ряда?
Не понял вашего вопроса.
Уточните свой код скрипта. На какую строку ругается vbs при запуске?
Что значит «данные со второго ряда»?
Благодарю за столь быстрый ответ.
В случае Argement is not optional:
Sub auto_email()
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
Dim Dest As Variant
Dim SDest As String
'e-mail subject
strSubj = "Subscripstion invoice overdue"
On Error GoTo dbg
' creating object for Outlook
Set olApp = CreateObject("Outlook.Application")
For iCounter = 1 To WorksheetFunction.CountA(Columns(1))
' creating new element ( email message ) in Outlook
Set olMailItm = olApp.CreateItem(0)
strBody = ""
useremail = Cells(iCounter, 2).Value
FullUsername = Cells(iCounter, 1).Value
Invoice = Cells(iCounter, 4).Value
Dateof = Cells(iCounter, 3).Value
acc_dep = Cells(iCounter, 5).Value
link_invoice = Cells(iCounter, 6).Value
' body of the email
strBody = "Dear " & FullUsername & vbCrLf
strBody = strBody & "Unfortunately, we have noticed that we have not received the payment for invoice #" & Invoice & "( link to the file)" & link_invoice & vbCrLf
strBody = strBody & "Could you please tell us when we can expect payment which is overdue from " & Dateof & vbCrLf
olMailItm.To = useremail
olMailItm.Subject = strSubj
olMailItm.BodyFormat = 1
olMailItm.CC = acc_dep
' 1 - text format of letter, 2 - HTML format of letter
olMailItm.Body = strBody
olMailItm.Save
olMailItm.Close
' etu strochku mojno ispolzovat dlia otkladki pisma
'MsgBox strBody
Set olMailItm = Nothing
Next iCounter
Set olApp = Nothing
dbg:
' errors, if yes
If Err.Description "" Then MsgBox Err.Description
End Sub я пытаюсь сохранить как Драфт сообщение.
Во втором случае: у меня в первом ряду наименование столбцов: name, email,status и прочее.
Поетому мне необходимо что б код выполнял команду со второго ряда.
1) У меня ваш код ругается только на предпоследдню строку. Заменил ее на свою «If Err.Description «» Then MsgBox Err.Description». Так на какую строчку кода ругается компилятор при запуске?
2) Начните следующий цикл с 2, а не с 1:
For iCounter = 1 To WorksheetFunction.CountA(Columns(1))
Добрый день!
Давно использую аналогичный механизм. Встала следующая задача: есть ползователи, включенные в Outlook в группу, у группы есть свой почтовый адрес, у пользователей есть разрешение отправлять письма от лица группы.
Как поменять адрес отправителя на адрес группы?
With objMail
.To = MailTo
.From = MailFrom
.Subject = MailSubject
.Body = MailText
If Len(MailAttachment) > 0 Then .Attachments.Add MailAttachment
.Send
End With
При подстановке адреса группы в переменную MailFrom, получатель все-равно видит адрес отправителя.
Этот макрос не поможет, он использует вашу конфигурацию Outlook. В вашем случае придется слать через почту через внешний vbs/powershell скрипт. Либо использовать какие-то другие классы/расширения Excel для отправки — тут я не подскажу, не пробовал.
Подскажите, пожалуйста, зачем объявляются эти переменные в коде?
Dim Dest As Variant
Dim SDest As String
Это не обязательно. Visual Basic позволяет динамически создавать переменные без объявления. Просто по правилам хорошего тона и улучшения производительности обычно стоит все-таки объявлять переменные в начале скрипта.
Что добавить, чтобы были сохранения в отправленных?
По умолчание письмо, отправленное из Outlook скриптом vbs сохранялось в отправленны. По крайней мере, было так когда я тестировал скрипт в outlook 2010.
увы, это не так) это в 2013 у меня так.
а есть похожий скрипт чтобы сохранялись в отправленных?
а вообще истоки где? чтобы почитать как создавать
Может нужно добавить что-то вида:
olMailItm.Save
Добрый день. В аутлуке подключено несколько учетных записей, как отправлять не от учетки по умолчанию, а от имени доп. ящика?
Скорее всего для отправки с доп. адреса outlook вам нужно добавить в ващ vba скрипт такую строку:
olMailItm.SentOnBehalfOfName = "yoursecondemail@domaincom"
Добрый день. Подскажите, может кто-нибудь сталкивался. Как вложить в тело письма рисунок. В данном макросе такое возможно?
Добавляйте файл с каринкой в виде вложения. См. пример выше:
olMailItm .Attachments.Add ("C:\Users\Desktop\send.jpg")
Добрый день,
Подскажите пожалуйста: есть макрос, который рассылает эксель файлы через аутлук. Все вроде бы нормально, но когда файлов много и в них много данных — не все отправляется.
Файлы созданы корректно, сохранены, но отправляются через раз. Такое озщущение, что аутлук в какой-то момент становится перегружен и перестает посылать эксели.
В чем может быть проблема? Может быть стоит попробовать другой формат файла или же срабатывает какая-то защита в аутлуке и он блокирует множественную отправку однотипных меилов?
Пробуйте делать таймаут между отправками в скрипте. Возможно просто не успевает outlook обрабатывать.
В 2010 Excel можно использовать такой таймаут:
Application.Wait(Now + #0:00:05#)
Добрый день. Подскажите, пожалуйста, как сделать, чтобы значение из столбца 3 вставлялось в текст жирным?
Я указала, что бы использовался html -это позволило ссылку вставить, но текст никак не делается жирным и цветным(
Используйте HTML формат письма:
И такой код сделает данное значение в теле письма жирным:
Замените скобки [ ] на < и >, сайт фильтрует их в комментариях
Добрый день!
К сожалению, оно так и отображает в письме теперь(
Текст
Может быть я что-то не так задала?
Sub send_email11()
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
strSubj = «Доступ»
On Error GoTo dbg
Set olApp = CreateObject(«Outlook.Application»)
For iCounter = 1 To WorksheetFunction.CountA(Columns(1))
Set olMailItm = olApp.CreateItem(0)
strBody = «»
useremail = Cells(iCounter, 2).Value
NazvanText = «[b]» & Cells(iCounter, 3).Value & «[/b]» — меняла скобки
strBody = «Добрый день! » & vbCrLf
strBody = strBody & «Текст » & NazvanText & strSign & vbCrLf
olMailItm.To = useremail
olMailItm.Subject = strSubj
olMailItm.BodyFormat = 2
olMailItm.Body = strBody
olMailItm.Send
Set olMailItm = Nothing
Next iCounter
Set olApp = Nothing
dbg:
If Err.Description «» Then MsgBox Err.Description
End Sub
тут почему-то преобразовало, а в письме нет(
так и отображается тэг СЛОВО закрытие тэга
Посмотрите какой формат определяет Outlook в полученном письме? Plain text или HTML?
Указан HTML. ссылка из ячейки 4 корректно подтягивается (гиперссылкой).
при изменении вида письма- ссылка становится текстом
Добрый день!
Подскажите мне настройки безопасности в EXCEL влияют на корректность работы данного макроса. Пытаюсь применить ваш код для выполнения задачи по рассылке ежечасной рассылке писем адресатам. Я в VBA не силен.
По умолчанию настройки Excel блокируют запуск макросов. Их запуск нужно разрешить. Хотя бы здесь посмотрите _https://support.microsoft.com/ru-ru/office/%D0%BA%D0%B0%D0%BA-%D0%B2%D0%BA%D0%BB%D1%8E%D1%87%D0%B0%D1%82%D1%8C-%D0%B8-%D0%BE%D1%82%D0%BA%D0%BB%D1%8E%D1%87%D0%B0%D1%82%D1%8C-%D0%BC%D0%B0%D0%BA%D1%80%D0%BE%D1%81%D1%8B-%D0%B2-%D0%B4%D0%BE%D0%BA%D1%83%D0%BC%D0%B5%D0%BD%D1%82%D0%B0%D1%85-12b036fd-d140-4e74-b45e-16fed1a7e5c6
Добрый день, спасибо огромное за статью,
а как можно сделать, чтобы в каждое письмо присоединялся персональный файл?
Есть выше к комментах:
olMailItm.Attachments.Add («C:\Users\Desktop\send.xls»)
Не могли бы вы помочь для моего случая нужно копировать содержимое файла, вставлять в письмо и прикреплять сам файл и отправлять на нужные адресаты. Заранее спасибо.
Чтобы из vbs получить содержимое текстового файла можно использовать такой код:
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.OpenTextFile("C:\test.txt", 1)
content = file.ReadAll
Дальше сами… 🙂
Добрый день
Хотел бы узнать, куда здесь можно написать .Display, чтобы просмотреть письмо перед отправкой.
Разобрался
Добрый день. Посдкажите. А как отправлять разное вложение, разным людям.
Я так понимаю команда olMailItm.Attachments.Add («C:\Users\Desktop\send.xls») делает рассылку одно и того файле всем.
Правильно, рассылается один файл. Если нужно каждому свой, нужно чтобы путь к файлу генерировался автоматически (например по имени пользователя). Указывать через переменную, например если имена файлов представляют собой email:
fileAttachm = "C:\Users\Desktop\" & useremail
olMailItm.Attachments.Add (fileAttachm)
А каким образом отправлять письмо без сохранения в отправленных?
Здравствуйте, спасибо Вам за внесенный вклад развития общества! 🙂
Здравствуйте!
я правильно понимаю, что макрос будет работать только в приложении(«Outlook.Application») , а если это веб версия outlook?
Все верно, на компьютере должен быть установлен outlook. Он вызывается через OLE.
С веб Outlook это не работает. Для отправки письма по SMTP можно использовать PowerShell командлет Send-MailMessage (https://winitpro.ru/index.php/2011/03/30/otpravka-pochty-iz-powershell/)
Здравствуйте ! у меня электронная подпись Outlook отображается в текстовом формате, как прописать код , чтобы текст был форматированным и логотип отображался? Помогите , кто может.
Sub Send_Mail()
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
Dim objTmpMail As Object
Application.ScreenUpdating = False
On Error Resume Next
Set objOutlookApp = GetObject(, «Outlook.Application»)
Err.Clear
If objOutlookApp Is Nothing Then
Set objOutlookApp = CreateObject(«Outlook.Application»)
End If
objOutlookApp.Session.Logon
Set objMail = objOutlookApp.CreateItem(0)
If Err.Number 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
With objMail
.To = Range(«A1»).Value
.Subject = Range(«A2»).Value
.Body = Range(«D2»).Value
.objMail.BodyFormat = 2
.Attachments.Add ActiveWorkbook.FullName
Set objTmpMail = objOutlookApp.CreateItem(0)
objTmpMail.display
objMail.Body = objMail.Body & objTmpMail.Body
objTmpMail.Delete
.Send
End With
exit_:
Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True
End Sub
Знаменитый LoveLetter отлично это делал в 2000-м
Рассылал сам себя по адресной книге того Outlook ‘a на котором открыли письмо с ним 😀
Ну это тогда будет следующий шаг при доработке кода 🙂
Добрый день! Не могли бы Вы помочь с кодом отправки письма только для выделенной строки, а не для всей таблицы?
Вопрос решен, оставлю код, может кому-то поможет:
Sub send_mail()
Dim olApp As Object
Dim olMailItm As Object
Dim iCounter As Integer
Dim Dest As Variant
Dim SDest As String
‘ тема письма
strSubj = «Статус выпуска ключа ПКЗИ»
On Error GoTo dbg
‘ создаем новый объект типа Outlook
Set olApp = CreateObject(«Outlook.Application»)
‘создаем новый элемент (письмо) в Outlook
Set olMailItm = olApp.CreateItem(0)
strBody = «»
useremail = Cells(ActiveCell.Row, 1).Value
FullUsername = Cells(ActiveCell.Row, 2).Value
Status = Cells(ActiveCell.Row, 4).Value
pwdchange = Cells(ActiveCell.Row, 3).Value
‘формируем тело письма
strBody = «Уважаемый » & FullUsername & vbCrLf
strBody = strBody & «Ваш ключ ПКЗИ выпущен » & Status & vbCrLf
strBody = strBody & «проверен: » & pwdchange & vbCrLf
olMailItm.To = useremail
olMailItm.Subject = strSubj
olMailItm.BodyFormat = 1
‘ 1 — текстовый формат письма, 2 — HTML формат
olMailItm.Body = strBody
olMailItm.Send
Set olMailItm = Nothing
‘ Next iCounter
Set olApp = Nothing
dbg:
‘отображение ошибок, если есть
If Err.Description «» Then MsgBox Err.Description
End Sub
добрый день!
подскажите, как сделать формат письма HTML? или приложить уже готовый файл HTML, чтобы он открывался в теле письма?
olMailItm.BodyFormat = 2
подходит для excel. а как через powershell?
Для PowerShell попробуйте такое:
Сформируйте HTML код в $strBody
А затем задайте формат письма:
$email.HTMLBody = $strBody
Добрый день! Спасибо за макрос!:)
Столкнулась с тем, что не отправляется письмо последнему адресату. т.е если строки в эксель файле 2 то письмо не направляется пользователю из второй строки. если строк 10, то не отправляется 10.