Как отправить письмо из Word при помощи VBA

1. Использование метода Routing Slip

Самый простой способ отправки документа по электронной почте - это использование встроенного в Word метода RoutingSlip. Используя его, можно отправлять сообщение как одному, так и нескольким адресатам, задавать заголовок и определять отправлять ли сообщение всем адресатам одновременно или пересылать сообщение по цепочке от одного к другому.

Преимущества использования метода RoutingSlip:

• Код будет работать со всеми почтовыми программами, нет необходимости заранее выяснять что именно установлено в системе.
• Даже не сохраненный документ может быть отправлен.
• Код будет работать быстрее, чем при автоматизации Outlook (конечно, если при запуске Вашего кода Outlook не запущен).

Недостатки использования RoutingSlip:

• В теле письма содержится текст по умолчанию, который не возможно изменить из кода.
• Текст самого документа не представляется возможным использовать как текст сообщения. Вы можете только приложить документ к письму.
• Вы не можете установить адреса для поля bcc (скрытой копии).

Вот пример кода для использования RoutingSlip

Activedocument.HasRoutingSlip = True
With Activedocument.RoutingSlip
    .Subject = "Новый заголовок"
    .AddRecipient "Firstaddress@Mail.com"
    .AddRecipient "Secondaddress@Mail.com"
    .Delivery = wdAllAtOnce
End With
Activedocument.Route

2. Автоматизация Outlook

Другая опция - это автоматизация Outlook для отсылки документа. Серьезным недостатком этой опции - является то, что Вы должны быть абсолютно уверены в том, что в системе запускающей код установлен Outlook.

Другим недостатком является то, что при отсылке документа в приложении к письму, документ должен быть хотя бы один раз сохранен. Это связанно с тем, что Вам необходим путь к документу и имя файла для кода.

Если при запуске кода Outlook не загружен, это способ будет медленнее.

И наконец, код несколько сложнее, чем при использовании метода Route. Установите ссылку на библиотеку Outlook (Tools-References в Visual Basic Editor) для правильной работы следующего кода:

Sub SendDocumentInMail()
Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
On Error Resume Next
'Получить объект Outlook, если он загружен
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
    'Outlook не загружен, запускаем его из кода
    Set oOutlookApp = CreateObject("Outlook.Application")
    bStarted = True
End If
'Создаем новый объект mailitem
Set oItem = oOutlookApp.CreateItem(olMailItem)
With oItem
    'Устанавливаем адрес для нового письма
   .To = "recipient@mail.com"
    'Устанавливаем адрес для копии письма 
    .CC = "recipient2@mail.com"
    'Устанавливаем заголовок
    .Subject = "Новый заголовок"
    'Текст документа используем как тело письма.
    .Body = ActiveDocument.Content
    .Send
End With
If bStarted Then
    'Если запустили Outlook из кода, то закрываем его 
    oOutlookApp.Quit
End If
'Все очищаем
Set oItem = Nothing
Set oOutlookApp = Nothing
End Sub

Этот код отправляет текст документа как содержимое письма ( то есть не прилагает его) и отправляет его чистым текстом, так что все его форматирование пропадет.

Вы можете отправить документ в приложении к письму, предусматривая, что документ был сохранен хотя бы один раз:

Sub SendDocumentAsAttachment()
Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
On Error Resume Next
If Len(ActiveDocument.Path) = 0 Then
    MsgBox "Документ должен быть вначале сохранен"
    Exit Sub
End If
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
    Set oOutlookApp = CreateObject("Outlook.Application")
    bStarted = True
End If
Set oItem = oOutlookApp.CreateItem(olMailItem)
With oItem
    .To = "recipient@mail.com"
    .Subject = "Новый заголовок"
    'Добавляя документ как приложение к письму, Вы можете использовать 
    'свойство .displayname для  установки описания используемого в сообщении 
    .Attachments.Add Source:=ActiveDocument.FullName, Type:=olByValue, _
      DisplayName:="Документ в приложении"
    .Send
End With
If bStarted Then
    oOutlookApp.Quit
End If
Set oItem = Nothing
Set oOutlookApp = Nothing
End Sub