Unable to Send Word Mail Merge Email in VBA Due to Word File not Opening
I have a table in access and a Word mail merge setup and linked to the table. I would like my customers to receive an email on a specific date stated in the table. I have created a template in word and started the mail merge process using the step-by-step mail merge wizard ready for VBA to send the email. I have tried this VBA code in Access, but it just keeps crashing and I think it is because it can't open the Word file. I am sure of this as I commented out the code line by line and it only crashed when I put Set wdDoc = wdApp.Documents.Open("C:\Users\Adam Khattab\Documents\Mail Merge - Copy.docx")
. I reviewed this this post, however, this is specifically for Access and not Excel.
Option Compare Database
Sub SendEmailsWord()
Const wdSendToEmail As Long = 0
Const wdMailFormatPlainText As Long = 2
On Error GoTo ErrorHandler
'Declare variables
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim strSQL As String
Dim rst As DAO.Recordset
'Set the reference to the Word application
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
On Error GoTo 0
If wdApp Is Nothing Then
Set wdApp = CreateObject("Word.Application")
End If
'Open the mail merge document
Set wdDoc = wdApp.Documents.Open("C:\Users\Adam Khattab\Documents\Mail Merge - Copy.docx")
'Set the reference to the recordset
strSQL = "SELECT * FROM CustomerBookingTBL WHERE EmailAddress IS NOT NULL"
Set rst = CurrentDb.OpenRecordset(strSQL)
'Start the mail merge
wdDoc.MailMerge.OpenDataSource "C:\Users\Adam Khattab\Documents\Customer_Bookings_Backup.accdb", strSQL
'Loop through the recordset and send each email
Do Until rst.EOF
wdDoc.MailMerge.Destination = wdSendToEmail
wdDoc.MailMerge.SuppressBlankLines = True
With wdDoc.MailMerge
.MailFormat = wdMailFormatPlainText
.MailSubject = "Mail Merge Subject"
.MailAsAttachment = False
.MailAddressFieldName = "EmailAddress"
.Execute Pause:=False
End With
rst.MoveNext
Loop
'Close the mail merge document
wdDoc.Close False
'Close the Word application
wdApp.Quit
Exit Sub
ErrorHandler:
MsgBox "An error occurred: " & Err.Description
End Sub
Comments
Post a Comment