How to Generate Offer Letters from Excel and Word Templates

Sub GenerateOfferLetters()
    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    Dim xlWS As Excel.Worksheet
    Dim lastRow As Long, i As Long
    
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim templatePath As String
    Dim outputDocPath As String
    Dim outputPdfPath As String
    Dim imgFolder As String
    
    '--- Configuration ---
    templatePath = ThisWorkbook.Path & "\OfferTemplate.docx"
    imgFolder = ThisWorkbook.Path & "\Photos"
    
    Set xlApp = Application
    Set xlWB = xlApp.ActiveWorkbook
    Set xlWS = xlWB.Sheets("Data")
    
    Set wdApp = New Word.Application
    wdApp.Visible = False
    
    lastRow = xlWS.Cells(xlWS.Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To lastRow 'Assume header in row 1
        Dim candidateName As String, position As String, salary As String, startDate As String
        Dim logoFile As String, signatureFile As String
        
        candidateName = xlWS.Cells(i, "A").Value
        position = xlWS.Cells(i, "B").Value
        salary = xlWS.Cells(i, "C").Value
        startDate = xlWS.Cells(i, "D").Text
        logoFile = xlWS.Cells(i, "E").Value
        signatureFile = xlWS.Cells(i, "F").Value
        
        Set wdDoc = wdApp.Documents.Open(templatePath, ReadOnly:=True)
        
        Call ReplacePlaceholder(wdDoc, "{{CandidateName}}", candidateName)
        Call ReplacePlaceholder(wdDoc, "{{Position}}", position)
        Call ReplacePlaceholder(wdDoc, "{{Salary}}", salary)
        Call ReplacePlaceholder(wdDoc, "{{StartDate}}", startDate)
        
        If Len(logoFile) > 0 Then Call InsertImage(wdDoc, "photo_logo", imgFolder & "\" & logoFile)
        If Len(signatureFile) > 0 Then Call InsertImage(wdDoc, "photo_signature", imgFolder & "\" & signatureFile)
        
        outputDocPath = ThisWorkbook.Path & "\OUTPUT\WORD\" & candidateName & " - Offer.docx"
        EnsureFolder ThisWorkbook.Path & "\OUTPUT\WORD\"
        wdDoc.SaveAs2 FileName:=outputDocPath, FileFormat:=wdFormatXMLDocument
        
        outputPdfPath = ThisWorkbook.Path & "\OUTPUT\PDF\" & candidateName & " - Offer.pdf"
        EnsureFolder ThisWorkbook.Path & "\OUTPUT\PDF\"
        wdDoc.ExportAsFixedFormat OutputFileName:=outputPdfPath, ExportFormat:=wdExportFormatPDF
        
        wdDoc.Close SaveChanges:=False
    Next i
    
    wdApp.Quit
    MsgBox "Offer letters generated: " & (lastRow - 1) & " documents.", vbInformation
End Sub

Private Sub ReplacePlaceholder(ByVal doc As Word.Document, ByVal placeholder As String, ByVal newText As String)
    With doc.Content.Find
        .Text = placeholder
        .Replacement.Text = newText
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceAll
    End With
End Sub

Private Sub InsertImage(ByVal doc As Word.Document, ByVal tag As String, ByVal imgPath As String)
    If Dir(imgPath) <> "" Then
        Dim rng As Word.Range
        Set rng = doc.Content
        With rng.Find
            .Text = "{{" & tag & "}}"
            .Replacement.Text = ""
            .Wrap = wdFindContinue
            .Execute
            If .Found Then
                rng.InlineShapes.AddPicture FileName:=imgPath, LinkToFile:=False, SaveWithDocument:=True
            End If
        End With
    End If
End Sub

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