I'm developing an excel macro that will enable me to send a set of emails, each with a different attachment, along with one of three pre-written emails that are saved as word documents. The only thing that isn't working properly is importing the email content from the word document. WordEditor appears to be the issue. The next problem message appears.
Err.Description:The operation failed.
Err.Number:-2147467259
Err.Source:Microsoft Outlook
Here is the code I have tried:
Sub SendDCLEmails()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim WordApp As Object
Dim WordDoc As Object
Dim DCLFile As String 'Attachment that differs for each email
Dim DCLCount As Integer 'Number of emails that will be sent
Dim toList As String
Dim ccList As String
Dim CoverLetter As String 'Word document template email
Dim fileCheckDCL As String
Dim fileCheckCover As String
Dim editor As Object
'Set references to Outlook
On Error Resume Next
Set OutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutlookApp = New Outlook.Application
On Error GoTo 0
'Set references to Word
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err <> 0 Then Set WordApp = New Word.Application
On Error GoTo 0
Sheets("Contacts").Select
'Create email for each record on "Contacts" tab
DCLCount = ActiveSheet.UsedRange.Rows.Count - 1
For i = 1 To DCLCount
DCLFile = Range("AD1").Offset(i, 0).Value & "\" & Range("AE1").Offset(i, 0).Value
CoverLetter = Range("AF1").Offset(i, 0).Value
fileCheckDCL = Dir(DCLFile)
fileCheckCover = Dir(CoverLetter)
'Run some validations and generate the toList and ccList variables.
Set WordDoc = WordApp.Documents.Open(CoverLetter)
WordDoc.Content.Copy
'Create Emails
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.Display
.To = toList
.CC = ccList
.Subject = Range("AG1").Offset(i, 0).Value
Set editor = .GetInspector.WordEditor 'This is where the error occurs.
editor.Content.Paste
.Attachments.Add DCLFile
.Send
End With
WordDoc.Close savechanges:=False
End If
toList = vbNullString
ccList = vbNullString
CoverLetter = vbNullString
DCLFile = vbNullString
fileCheckDCL = vbNullString
fileCheckCover = vbNullString
Set editor = Nothing
Next i
OutlookApp.Quit
WordApp.Quit
End Sub