Возникла задача организации рассылки писем по списку email пользователей в Excel. Причем в каждом письме нужно указывать некоторые данные, индивидуальные для каждого пользователя. Я попытался реализовать этот функционал с помощью vba макроса в Excel, который отправляет почту через настроенный на компьютере почтовый профиль Outlook. Ниже мое решение.
Допустим, у нас есть Excel файл, содержащий следующие столбцы:
Email пользователя | ФИО | Время последней смены пароля | Статус учетной записи
В рамках моей задачи нужно каждому пользователю из списка отправить письмо вида:
Тема: Статус учетной записи в домене winitpro.ru
Тело письма: Уважаемый %FullUsername%
Ваша учетная запись в домене winitpro.ru — %status%
Время последней смены пароля: %pwdchange%Совет. Если для учетных записей пользователей нужно получить значение одного из атрибутов пользователя в Active Directory, можно воспользоваться решением из статьи Функция Excel для получения данных пользователя из AD.
Создадим новый макрос: вкладка Вид -> Макросы. Укажите имя макроса send_email и нажмите кнопку Создать:
В открывшемся редакторе VBA вставьте следующий код (я снабдил его всеми необходимыми комментариями). Для автоматизации отправки писем я воспользуюсь функцией CreateObject(«Outlook.Application»), позволяющей создать и использовать в скрипте объект приложения Outlook.
Важно. На компьютере, рассылающем письма должен быть установлен и настроен почтовый профиль 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 = 1 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
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 из списка.