Виникла задача організації розсилки листів за списком 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.
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 зі списку.
