Макрос VBA, использующий данные из документа Word и книги Excel для отправки сообщений из Outlook

  • Статья
  • Применяется к:
    Outlook

Сводка

В этой статье описывается макрос Visual Basic для приложений, который использует данные из документа Microsoft Word и книги Microsoft Excel для отправки сообщений из Microsoft Outlook.

Дополнительная информация

Важно!

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

В следующем примере предполагается, что на листе есть два определенных имени:

  • Первое определенное имя subjectcell ссылается на ячейку, содержащую строку темы сообщения (например, "Это тестовое сообщение".)
  • Второе определенное имя , tolist, ссылается на первую ячейку в горизонтальном списке, которая содержит список получателей (например, "John Doe", "Jane Doe" и т. д.).

У вас также должен быть документ Microsoft Word. Текст этого документа используется макросом в качестве текста сообщения.

Sub SendOutlookMessages()'Dimension variables.
    Dim OL As Object, MailSendItem As Object
    Dim W As Object
    Dim MsgTxt As String, SendFile As String
    Dim ToRangeCounter As Variant
    
    'Identifies Word file to send
    SendFile = Application.GetOpenFilename(Title:="Select MS Word " & _
    "file to mail, then click 'Open'", buttontext:="Send", _
    MultiSelect:=False)'Starts Word session
    Set W = GetObject(SendFile)'Pulls text from file for message body
    MsgTxt = W.Range(Start:=W.Paragraphs(1).Range.Start, _
    End:=W.Paragraphs(W.Paragraphs.Count).Range.End)'Ends Word session
    Set W = Nothing
    
    'Starts Outlook session
    Set OL = CreateObject("Outlook.Application")
    Set MailSendItem = OL.CreateItem(olMailItem)
    
    ToRangeCounter = 0
    
    'Identifies number of recipients for To list.
    For Each xCell In ActiveSheet.Range(Range("tolist"), _
    Range("tolist").End(xlToRight))
    ToRangeCounter = ToRangeCounter + 1
    Next xCell
    
    If ToRangeCounter = 256 Then ToRangeCounter = 1
    
    'Creates message
    With MailSendItem
    .Subject = ActiveSheet.Range("subjectcell").Text
    .Body = MsgTxt
    
    'Creates "To" list
    For Each xRecipient In Range("tolist").Resize(1, ToRangeCounter)
    RecipientList = RecipientList & ";" & xRecipient
    Next xRecipient
    
    .To = RecipientList
    .Send
    End With
    
    'Ends Outlook session
    Set OL = Nothing
    
End Sub