Word Templates vs HTML-to-PDF Pipelines for Business Documents

Option Explicit

Sub GenerateDocuments()
    Dim xlApp As Application
    Dim xlWb As Workbook
    Dim xlWs As Worksheet
    Dim wdApp As Object ' Word.Application
    Dim wdDoc As Object ' Word.Document
    Dim fso As Object ' Scripting.FileSystemObject
    Dim srcRow As Long
    Dim lastRow As Long
    Dim templatePath As String
    Dim outputWordFolder As String
    Dim outputPdfFolder As String
    Dim imageFolder As String
    Dim placeholder As String
    Dim cellValue As String

    '--- Settings -------------------------------------------------------
    templatePath = ThisWorkbook.Path & "\Template.docx"
    outputWordFolder = ThisWorkbook.Path & "\OUTPUT\WORD"
    outputPdfFolder = ThisWorkbook.Path & "\OUTPUT\PDF"
    imageFolder = ThisWorkbook.Path & "\Images"
    '-------------------------------------------------------------------

    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(outputWordFolder) Then fso.CreateFolder outputWordFolder
    If Not fso.FolderExists(outputPdfFolder) Then fso.CreateFolder outputPdfFolder
    If Not fso.FolderExists(imageFolder) Then
        MsgBox "Image folder not found: " & imageFolder, vbCritical
        Exit Sub
    End If

    Set xlApp = Application
    Set xlWb = xlApp.ActiveWorkbook
    Set xlWs = xlWb.Sheets(1)

    srcRow = 2 ' assuming header row
    lastRow = xlWs.Cells(xlWs.Rows.Count, "A").End(-4162).Row ' xlUp

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

    For i = srcRow To lastRow
        Set wdDoc = wdApp.Documents.Open(templatePath, ReadOnly:=False)
        '--- Text placeholders ---------------------------------------
        For Each cell In xlWs.Range("A" & i & ":Z" & i) ' adjust column range as needed
            placeholder = "{{" & cell.Column - 1 & "}}" ' simple numeric tag example
            cellValue = CStr(cell.Value)
            With wdDoc.Content.Find
                .ClearFormatting
                .Text = placeholder
                .Replacement.Text = cellValue
                .Wrap = 1 ' wdFindContinue
                .Execute Replace:=2 ' wdReplaceAll
            End With
        Next cell
        '--- Image placeholders ---------------------------------------
        Dim tags As Variant
        tags = Array("photo_logo", "photo_signature", "photo_stamp")
        Dim tag As Variant
        For Each tag In tags
            Dim imgPath As String
            imgPath = imageFolder & "\" & tag & ".png"
            If fso.FileExists(imgPath) Then
                With wdDoc.Content.Find
                    .ClearFormatting
                    .Text = "{{" & tag & "}}"
                    .Wrap = 1
                    .Execute
                    If .Found Then
                        wdDoc.InlineShapes.AddPicture Filename:=imgPath, LinkToFile:=False, SaveWithDocument:=True, Range:=wdDoc.Range(.Parent.Start, .Parent.End)
                    End If
                End With
            End If
        Next tag
        '--- Save DOCX ------------------------------------------------
        Dim outDocPath As String
        outDocPath = outputWordFolder & "\Document_" & i & ".docx"
        wdDoc.SaveAs2 outDocPath, 16 ' wdFormatXMLDocument
        '--- Export PDF ---------------------------------------------
        Dim outPdfPath As String
        outPdfPath = outputPdfFolder & "\Document_" & i & ".pdf"
        wdDoc.ExportAsFixedFormat OutputFileName:=outPdfPath, ExportFormat:=17 ' wdExportFormatPDF
        wdDoc.Close False
    Next i

    wdApp.Quit
    Set wdDoc = Nothing
    Set wdApp = Nothing
    MsgBox "Generation complete: " & (lastRow - srcRow + 1) & " documents created.", vbInformation
End Sub