2022-12-30

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


No comments:

Post a Comment