Excel → Word → PDF Workflow for Membership Certificates

Option Explicit

Sub GenerateCertificates()
    Dim xlWs As Worksheet
    Dim lo As ListObject
    Dim rw As ListRow
    Dim wdApp As Object ' Late‑bound Word.Application
    Dim wdDoc As Object ' Word.Document
    Dim templatePath As String
    Dim outWordFolder As String
    Dim outPdfFolder As String
    Dim imgFolder As String

    '--- Settings ------------------------------------------------------
    templatePath = ThisWorkbook.Path & "\CertificateTemplate.docx"
    outWordFolder = ThisWorkbook.Path & "\Word_Output"
    outPdfFolder = ThisWorkbook.Path & "\PDF_Output"
    imgFolder = ThisWorkbook.Path & "\Images"

    ' Ensure output folders exist
    CreateFolderIfMissing outWordFolder
    CreateFolderIfMissing outPdfFolder

    Set xlWs = ThisWorkbook.Sheets("Members")
    Set lo = xlWs.ListObjects(1) ' assumes the first table holds the data

    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = False

    For Each rw In lo.ListRows
        Dim memberName As String
        Dim level As String
        Dim issueDate As String
        Dim logoFile As String
        Dim sigFile As String
        Dim outBase As String

        memberName = rw.Range.Columns(1).Value
        level = rw.Range.Columns(2).Value
        issueDate = rw.Range.Columns(3).Value
        logoFile = rw.Range.Columns(4).Value
        sigFile = rw.Range.Columns(5).Value
        outBase = CleanFileName(memberName) & "_" & level

        Set wdDoc = wdApp.Documents.Open(templatePath, ReadOnly:=True)

        Call ReplacePlaceholder(wdDoc, "<<MemberName>>", memberName)
        Call ReplacePlaceholder(wdDoc, "<<MembershipLevel>>", level)
        Call ReplacePlaceholder(wdDoc, "<<IssueDate>>", issueDate)

        ' Insert logo if file exists
        If Len(logoFile) > 0 Then
            Call InsertPicture(wdDoc, "logo_placeholder", imgFolder & "\" & logoFile)
        End If
        ' Insert signature if file exists
        If Len(sigFile) > 0 Then
            Call InsertPicture(wdDoc, "signature_placeholder", imgFolder & "\" & sigFile)
        End If

        Dim wordPath As String, pdfPath As String
        wordPath = outWordFolder & "\" & outBase & ".docx"
        pdfPath = outPdfFolder & "\" & outBase & ".pdf"

        wdDoc.SaveAs2 Filename:=wordPath, FileFormat:=16 ' wdFormatXMLDocument
        wdDoc.ExportAsFixedFormat OutputFileName:=pdfPath, ExportFormat:=17 ' wdExportFormatPDF
        wdDoc.Close SaveChanges:=False
    Next rw

    wdApp.Quit
    Set wdDoc = Nothing
    Set wdApp = Nothing
    MsgBox "Certificate batch completed.", vbInformation
End Sub

Sub ReplacePlaceholder(ByVal doc As Object, ByVal placeholder As String, ByVal newText As String)
    With doc.Content.Find
        .Text = placeholder
        .Replacement.Text = newText
        .Wrap = 1 ' wdFindContinue
        .Execute Replace:=2 ' wdReplaceAll
    End With
End Sub

Sub InsertPicture(ByVal doc As Object, ByVal shapeName As String, ByVal picPath As String)
    Dim shp As Object
    On Error Resume Next
    Set shp = doc.Shapes(shapeName)
    On Error GoTo 0
    If Not shp Is Nothing Then
        If Dir(picPath) <> "" Then
            shp.Fill.UserPicture picPath
        End If
    End If
End Sub

Sub CreateFolderIfMissing(ByVal folderPath As String)
    If Dir(folderPath, vbDirectory) = "" Then
        MkDir folderPath
    End If
End Sub

Function CleanFileName(ByVal s As String) As String
    Dim invalidChars As Variant
    invalidChars = Array("/", "\\", ":", "*", "?", """, "<", ">", "|")
    Dim ch As Variant
    For Each ch In invalidChars
        s = Replace(s, ch, "_")
    Next ch
    CleanFileName = s
End Function