使用 Excel VBA 将 Word 文档作为电子邮件发送到 Excel 中的列表

Question

我想将文档作为电子邮件（不是附件）多次发送到 Excel 中的电子邮件地址列表。

我的 Excel sheet 的列表格式如下：

+--------------------------------------------------------+----------------+-------------------------------------+---------------------------------------+----------------+----------------------------+
|                         Emails                         |      CC1       | CC2 - Primary Electronic Sales - US | CC3 - Primary Electronic Trading - US | Additional CC? | Concatenation of all CC's  |
+--------------------------------------------------------+----------------+-------------------------------------+---------------------------------------+----------------+----------------------------+
| email@domain.com; email2@domain.com; email3@domain.com | Outlook Name 1 | Outlook name 2                      | Outlook name 3                        | Outlook name 4 | Concatenation of all CC's  |  
+--------------------------------------------------------+----------------+-------------------------------------+---------------------------------------+----------------+----------------------------+

目标是加载文档 "H:\Thought Pieces\Small Cap Names.doc" 并将文档作为电子邮件（不是附件）发送到 "Emails" 列中的每个条目，并抄送 "Concatenation of all CC's"列。

主题可以是静态的，我不会更改它。现在，邮件仅发送到第一行，正确地通过电子邮件发送第一行第二列中的列表，并抄送第一行最后一列中的列表。

但它挂起，并说

Method 'Subject' of object '_MailItem' failed

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

 Set wd = CreateObject("Word.Application")
 Dim doc As Word.Document

 'Assigns Word file to send
 Set wd = GetObject(, "Word.Application")
 If wd Is Nothing Then
      Set wd = CreateObject("Word.Application")
      blnWeOpenedWord = True
 End If
 Set doc = wd.Documents.Open _
 (Filename:="H:\Thought Pieces\Small Cap Names.doc", ReadOnly:=True)
 Set itm = doc.MailEnvelope.Item

 'Starts Outlook session
 Set OL = CreateObject("Outlook.Application")
 Set MailSendItem = doc.MailEnvelope.Item

 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
 For Each xRecipient In Range("tolist")
     With MailSendItem
          .Subject = ActiveSheet.Range("subjectcell").Text
          .Body = MsgTxt
          .To = xRecipient
          .Cc = xRecipient.Offset(0, 6)
          .Send
     End With
 Next xRecipient

 'Ends Outlook session
 Set OL = Nothing

End Sub

Answer 1

所以...经过一系列试验，我实际上想出了自己的问题。

我加了第二个"Set MailSendItem = doc.MailEnvelope.Item" 在循环内，因为显然一旦 .Send 通过，该项目就会消失。

我希望这对以后的人有所帮助。

使用 Excel VBA 将 Word 文档作为电子邮件发送到 Excel 中的列表

Send Word document as an e-mail to a list in Excel using Excel VBA

excel

outlook

vba

ms-word