В этой статье я бы хотел поделиться опытом автоматизации офисной, рутинной задачи по отправке сообщений группе клиентов.
Итак, собственно, в чем вопрос: необходимо отправить электронные письма с вложением нескольким десяткам клиентам. При этом в поле получателя должен быть только один адрес, т.е. клиенты друг о друге не должны знать. Кроме того, не допускается установка дополнительного программного обеспечения, типа 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
А теперь и вложения. Тут я использовал динамический массив и возможность множественного выбора диалога.
Каждый раз я создавал и удалял объект fd из-за того, что это сделать проще, чем заниматься его чисткой перед последующим вызовом.
Для получения данных из текстовых файлов пришлось использовать пару дополнительных функций. Вызываются они таким образом:
txtBody = ReadTXTfile(Path2Body) Item2To = ReadTXTfile2Arr(Path2To) С целью отладки я вставил такой код
'Контроль за данными
'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. Тогда созданные письма окажутся в папке "Черновики".
Здесь полный код модуля "как есть".
В данном примере реализована возможность отправки простых писем. Если необходимо расширить возможности, например сделать текст форматированным, то двигаться следует в направлении Outlook.MailItem > GetInspector > WordEditor. Это, мягко говоря, усложняет код, но позволит использовать в качестве источника текста письма форматированный документ Word.
Можно также добавить обработку "преднамеренного" отсутствия каких-либо составляющих письма. Например, реализовать отправку без темы, текста или вложений. Сейчас отказ от одного из этих элементов приведет к прерыванию процедуры.
Этот код, теоретически, должен работать также и в более ранних версиях Microsoft Office. Поменяется только ссылка на библиотеку Excel.