CODEWITHSUNDEEP
excelvbaoutlookms-word
pugmastaflex
pugmastaflex

Reputation: 470

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

I want to send a document as an email (not an attachment), multiple times to a list of e-mail addresses in Excel.

My Excel sheet has my list in this format:

+--------------------------------------------------------+----------------+-------------------------------------+---------------------------------------+----------------+----------------------------+
|                         Emails                         |      CC1       | CC2 - Primary Electronic Sales - US | CC3 - Primary Electronic Trading - US | Additional CC? | Concatenation of all CC's  |
+--------------------------------------------------------+----------------+-------------------------------------+---------------------------------------+----------------+----------------------------+
| [email protected]; [email protected]; [email protected] | Outlook Name 1 | Outlook name 2                      | Outlook name 3                        | Outlook name 4 | Concatenation of all CC's  |  
+--------------------------------------------------------+----------------+-------------------------------------+---------------------------------------+----------------+----------------------------+

The goal is to load the document "H:\Thought Pieces\Small Cap Names.doc" and send the document as an e-mail (not attachment) to the each of the entries in the "Emails" column as well as ccing the "Concatenation of all CC's" column.

The subject can be static I won't be changing it. Right now, the mail sends only to the first row, correctly emailing the list in the second column, first row and ccing the list in the last column, first row.

But it hangs, and says

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

Upvotes: 1

Views: 3015

Answers (1)

pugmastaflex
pugmastaflex

Reputation: 470

So...I actually figured my own question out after a bunch of trials.

I added a second "Set MailSendItem = doc.MailEnvelope.Item" inside the loop because apparently the item disappears once .Send is passed.

I hope this helps someone in the future.

Upvotes: 2

Related Questions