Отправка электронной почты с использованием Collaboration Data Objects (CDO)
Материал из GedeminWiki
Библиотека Collaboration Data Objects (CDO) является частью операционной системы, начиная с версии Windows 2000, и предоставляет программисту объекты для работы с электронной почтой.
Пример отсылки простого сообщения
Option Explicit Sub SendEmail '''''''''''''''''''''''''''''''''''''''''''' ' Объявляем переменную и создаем объект ' для работы с электронной почтой Dim objMessage Set objMessage = CreateObject("CDO.Message") '''''''''''''''''''''''''''''''''''''''''''' ' Заполняем поля сообщения ' Заголовок сообщения objMessage.Subject = "Привет от Гедымина!" ' Обратный адрес. Не забудьте указать свой! objMessage.From = "xxxx@yyyy.by" ' Кому посылаем. Пропишите тут правильный адрес! objMessage.To = "xxxx@yyyy.by" ' Текст сообщения objMessage.TextBody = "Это сообщение отослано из макроса." '''''''''''''''''''''''''''''''''''''''''''' ' Указываем параметры почтового сервера ' Если они Вам неизвестны -- проконсультируйтесь ' у своего провайдера. objMessage.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 ' Адрес SMTP servera objMessage.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "yyyy.by" objMessage.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 ' Имя пользователя. Укажите правильную информацию! objMessage.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/sendusername") = "user" ' Пароль objMessage.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password" ' Номер порта. Если в Вашей сети используется брэндмаур, ' убедитесь, что соответствующий порт открыт! objMessage.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 objMessage.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False objMessage.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60 objMessage.Configuration.Fields.Update '''''''''''''''''''''''''''''''''''''''''''' ' Посылаем сообщение objMessage.Send End Sub
Вам наверняка захочется поэксперементировать с приведенным здесь кодом и отослать несколько тестовых сообщений на один и тот же адрес. Будьте внимательны, так как почтовая система может трактовать такую рассылку как вредный спам и поместить ваши послания в соответствующую папку.
Автоматическое построение и отсылка отчета
Ниже приводится пример макроса, предложенный nkornachenko, который строит отчет, сохраняет его в PDF файле и отсылает на указанный адрес электронной почты.
... Dim B(2) Set B(0) = OwnerForm B(1) = Date B(2) = Array(CarType) Dim FileName, objMessage, WScript FileName = ... Call System.ReportSystem.ExportReportWithParam(<id отчета>, B, FileName , "PDF") Set WScript = CreateObject("WScript.Shell") Call WScript.Run("ping localhost", 1, True) 'Это пауза, потому что отчет не успевает Call WScript.Run("ping localhost", 1, True) 'построиться до отправки так как строится в отдельном потоке 'WScript.Sleep 5000 'Пауза, чтобы отчет успел построиться Set objMessage = CreateObject("CDO.Message") objMessage.Subject = "Тема письма" objMessage.From = "xxxxx@yyyy.by" objMessage.To = "xxxxx@yyyy.by" objMessage.TextBody = "Текст письма" objMessage.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 objMessage.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "xxx.xxx.xxx.xxx" 'Адрес SMTP servera objMessage.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 objMessage.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxxx" 'Имя пользователя objMessage.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "yyyyy" 'Пароль objMessage.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 objMessage.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False objMessage.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60 If FileName > "" Then objMessage.MimeFormatted = True objMessage.AddAttachment(FileName) End if objMessage.Configuration.Fields.Update objMessage.Send ...