Отправка электронной почты с использованием 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
  ...

См. также

Персональные инструменты
Пространства имён

Варианты
Действия
Навигация
Инструменты