使用 Word 文档和 Excel 工作簿中的数据从 Outlook 发送邮件的 VBA 宏

摘要

本文介绍 Visual Basic for Applications 宏，该宏使用来自 Microsoft Word 文档的数据和Microsoft Excel 工作簿从 Microsoft Outlook 发送邮件。

详细信息

重要

Microsoft 提供的编程示例仅用于进行说明，而不提供明示或默示担保。 这包括但不限于适销性或对特定用途的适用性的默示担保。 本文假设您熟悉正在演示的编程语言和用于创建和调试过程的工具。 Microsoft 支持工程师可以帮助解释特定过程的功能，但他们不会修改这些示例以提供新增功能或构建步骤以满足你的特定需要。

以下示例假定工作表中有两个定义的名称：

• 第一个定义的名称，subjectcell，是指包含邮件主题行（例如，“这是测试消息”）的单元格。
• 第二个定义的名称（要列出）是指包含收件人列表的水平列表中的第一个单元格（例如，“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