Mail Merge and Save Result as PDF - cannot make the word document current

[grapevine]

I have a spreadsheet containing names and courses which is connected to a Word Document which produces certificates and I want to automate the process.

I have managed to get the mail merge automated, but I cannot get the resulting Form Letter1 document to save as a PDF document.

I cannot seem to make the Form Letter 1 the document from which to create the pdf. My code is as follows: The part that is causing me problems is the section which I have highlighted separately - I have tried many different methods and just cannot seem to get this final part. Any better/easier solutions gratefully received or any pointers as to what I am doing wrong.
Many thanks

Dim wrdDoc As Word.Document   'This is the part that is erroring out
Set wrdDoc = wd.Documents       'This is the part that is erroring out

Sub RunMerge()

    Dim wd As Object
    Dim wdocSource As Object
    Dim objdoc As Document

    Dim strWorkbookName As String

    On Error Resume Next
    Set wd = GetObject(, "Word.Application.16")
    If wd Is Nothing Then
        Set wd = CreateObject("Word.Application.16")
    End If
    On Error GoTo 0

    Set wdocSource = wd.Documents.Open("C:\Users\Marion\OneDrive - Grapevine Computing Ltd\Tutoring\Course Materials\Lesson Files\Auxcillary Documents\Certificate of Attendance.docx")

    strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name

    wdocSource.MailMerge.MainDocumentType = wdFormLetters

    wdocSource.MailMerge.OpenDataSource _
            Name:=strWorkbookName, _
            AddToRecentFiles:=False, _
            Revert:=False, _
            Format:=wdOpenFormatAuto, _
            Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
            SQLStatement:="SELECT * FROM `Certificates$` WHERE `Name` IS NOT NULL ORDER BY `Name` ASC "

    With wdocSource.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With

    wd.Visible = True
    wdocSource.Close SaveChanges:=False
    Dim wrdDoc As Word.Document   'This is the part that is erroring out
    Set wrdDoc = wd.Documents       'This is the part that is erroring out
  
wrdDoc.ExportAsFixedFormat OutputFileName:="C:\Users\Marion\OneDrive - Grapevine Computing Ltd\Tutoring\Course Materials\Lesson Files\Auxcillary Documents\Certificates.pdf", _
      ExportFormat:=wdExportFormatPDF


End Sub

 

[grapevine]

I have managed to get this working and emailing so for future reference for someone with the same problem the code was as follows. I should have been using Word.Document not just Document.

Dim objdoc As Word.Document

 

[Macropod]

Since you've evidently set a reference to the Word Object model, I'd suggest:

Sub RunMerge()
Dim wdApp As New Word.Application, wdDoc As Word.Document, strWkBkNm As String, strPath As String
strWkBkNm = ThisWorkbook.FullName
strPath = "C:\Users\Marion\OneDrive - Grapevine Computing Ltd\Tutoring\Course Materials\Lesson Files\Auxcillary Documents\"
'Disable alerts to prevent an SQL prompt
With wdApp
    .Visible = True
    .DisplayAlerts = wdAlertsNone
    Set wdDoc = .Documents.Open(strPath & "Certificate of Attendance.docx", ReadOnly:=True, AddToRecentFiles:=False)
    With wdDoc
        With .MailMerge
            .MainDocumentType = wdFormLetters
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
            .OpenDataSource Name:=strWkBkNm, AddToRecentFiles:=False, Revert:=False, _
                Format:=wdOpenFormatAuto, Connection:="Data Source=" & strWkBkNm & ";Mode=Read", _
                SQLStatement:="SELECT * FROM `Certificates$` WHERE `Name` IS NOT NULL ORDER BY `Name` ASC "
            .DataSource.FirstRecord = wdDefaultFirstRecord
            .DataSource.LastRecord = wdDefaultLastRecord
            .Execute Pause:=False
        End With
        .Close SaveChanges:=False
    End With
    .ActiveDocument.SaveAs2 Filename:=strPath & "Certificates.pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
    .ActiveDocument.Close SaveChanges:=False
    'Restore the Word alerts
    .DisplayAlerts = wdAlertsAll
    .Quit
End With
Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

Once you're satisfied it's running correctly, you can change '.Visible = True' to '.Visible = False'. Setting '.DisplayAlerts = wdAlertsNone' prevents the code stalling if someone sets your 'Certificate of Attendance' document up as a mailmerge main document. This allows you the flexibility to run the merge from that document itself, or via the macro.

 

[grapevine]

Thank you for you additional information, I will incorporate those checks into my code. Most of my Dim Statements are in another macro which calls this and another macro to email the files. I am familiar with hiding alerts in Excel but did not know how to do it in Word, so thank you for that.
Many thanks

 

[Macropod]

another macro to email the files.

Am I to understand from that that you want to email each person's certificate? As coded, the merge would output all certificates to a single file. A few coding changes could be made to output each record to a separate PDF.

 

[grapevine]

Am I to understand from that that you want to email each person's certificate? As coded, the merge would output all certificates to a single file. A few coding changes could be made to output each record to a separate PDF.

If you could let me have the script that would be great. The company seem fine with the format at the moment, but they might want something different in the future
Many thanks

 

[Macropod]

Try:

Sub RunMerge()
Dim wdApp As New Word.Application, wdDoc As Word.Document, strWkBkNm As String, strPath As String
Dim StrNm As String, i As Long, j As Long
'Illegal filename characters
Const StrNoChr As String = """*./\:?|"
strWkBkNm = ThisWorkbook.FullName
strPath = "C:\Users\Marion\OneDrive - Grapevine Computing Ltd\Tutoring\Course Materials\Lesson Files\Auxcillary Documents\"
'Disable alerts to prevent an SQL prompt
With wdApp
    .Visible = True
    .DisplayAlerts = wdAlertsNone
    Set wdDoc = .Documents.Open(strPath & "Certificate of Attendance.docx", ReadOnly:=True, AddToRecentFiles:=False)
    With wdDoc
        With .MailMerge
            .MainDocumentType = wdFormLetters
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
            .OpenDataSource Name:=strWkBkNm, AddToRecentFiles:=False, Revert:=False, _
                Format:=wdOpenFormatAuto, Connection:="Data Source=" & strWkBkNm & ";Mode=Read", _
                SQLStatement:="SELECT * FROM `Certificates$` WHERE `Name` IS NOT NULL ORDER BY `Name` ASC "
            'Process each record
            For i = 1 To 10 '.DataSource.RecordCount
                With .DataSource
                    .FirstRecord = i
                    .LastRecord = i
                    .ActiveRecord = i
                    'Get the output filename
                    StrNm = .DataFields("Name")
                End With
                'Remove specified illegal characters from the file name
                For j = 1 To Len(StrNoChr)
                    StrNm = Replace(StrNm, Mid(StrNoChr, j, 1), "_")
                Next
                StrNm = Trim(StrNm)
                'Create the mailmerge output for this record
                .Execute Pause:=False
                'The output document will automatically be the 'active' one
                With wdApp.ActiveDocument
                    .SaveAs Filename:=strPath & StrNm & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
                    'Close the output file
                    .Close SaveChanges:=False
                End With
            Next i
        End With
        .Close SaveChanges:=False
    End With
    'Restore the Word alerts
    .DisplayAlerts = wdAlertsAll
    .Quit
End With
Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

As coded, the macro gets the filenames from your 'name' field.

 

[grapevine]

Thank you very much for this, I will try it out so I have it working in case I need it. Might get some brownie points if I offer it as an option!
Many thanks for your help, it is appreciated