How to Generate Supplier Forms and Procurement Packs

Option Explicit

Sub GenerateSupplierPacks()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim wdApp As Object ' Word.Application
    Dim wdDoc As Object ' Word.Document
    Dim templatePath As String
    Dim outputWordFolder As String
    Dim outputPdfFolder As String
    Dim imageFolder As String
    Dim supplierName As String
    Dim logoFile As String
    Dim signatureFile As String
    Dim stampFile As String
    Dim docName As String

    '--- configuration ---------------------------------------------------
    templatePath = ThisWorkbook.Path & "\SupplierFormTemplate.docx"
    outputWordFolder = ThisWorkbook.Path & "\Output\WORD"
    outputPdfFolder = ThisWorkbook.Path & "\Output\PDF"
    imageFolder = ThisWorkbook.Path & "\Images"
    '--------------------------------------------------------------------

    Set ws = ThisWorkbook.Worksheets("Suppliers")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' Ensure output folders exist
    If Dir(outputWordFolder, vbDirectory) = "" Then MkDir outputWordFolder
    If Dir(outputPdfFolder, vbDirectory) = "" Then MkDir outputPdfFolder

    ' Start hidden Word instance
    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = False

    For i = 2 To lastRow ' assuming header row
        supplierName = ws.Cells(i, "A").Value
        logoFile = ws.Cells(i, "B").Value ' LogoFileName column
        signatureFile = ws.Cells(i, "C").Value ' SignatureFileName column
        stampFile = ws.Cells(i, "D").Value ' StampFileName column

        ' Open template copy
        Set wdDoc = wdApp.Documents.Open(templatePath, ReadOnly:=False)

        ' Fill text bookmarks
        On Error Resume Next
        wdDoc.Bookmarks("SupplierName").Range.Text = supplierName
        On Error GoTo 0

        ' Insert images if files exist
        If logoFile <> "" Then Call InsertImage(wdDoc, "photo_logo", imageFolder & "\" & logoFile)
        If signatureFile <> "" Then Call InsertImage(wdDoc, "photo_signature", imageFolder & "\" & signatureFile)
        If stampFile <> "" Then Call InsertImage(wdDoc, "photo_stamp", imageFolder & "\" & stampFile)

        ' Build output filenames
        docName = Replace(supplierName, " ", "_") & "_Form"
        wdDoc.SaveAs2 FileName:=outputWordFolder & "\" & docName & ".docx"
        wdDoc.ExportAsFixedFormat OutputFileName:=outputPdfFolder & "\" & docName & ".pdf", ExportFormat:=17 ' wdExportFormatPDF

        wdDoc.Close SaveChanges:=False
    Next i

    wdApp.Quit
    Set wdDoc = Nothing
    Set wdApp = Nothing
    MsgBox "Supplier forms and procurement packs generated successfully.", vbInformation
End Sub

Sub InsertImage(ByRef doc As Object, ByVal placeholderTag As String, ByVal imgPath As String)
    Dim rng As Object
    Dim shp As Object
    
    If Dir(imgPath) = "" Then Exit Sub ' file not found
    
    ' Find placeholder text
    Set rng = doc.Content
    With rng.Find
        .Text = placeholderTag
        .Replacement.Text = ""
        .Execute Replace:=2 ' wdReplaceAll
    End With

    ' Insert picture at the range where placeholder was
    Set shp = doc.InlineShapes.AddPicture(FileName:=imgPath, LinkToFile:=False, SaveWithDocument:=True, Range:=rng)
    ' Optional: adjust size if needed
    shp.Width = 150 ' points
    shp.Height = 50 ' points
End Sub