Untitled

Sub SendLetter()

    Dim wordApp As Object
    Dim wordDoc As Object
    Dim ws As Worksheet
    Dim recipientName As String
    Dim recipientAddress As String
    Dim dateStr As String
    Dim apeAmount As String
    
    ' Open Excel workbook and set worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your worksheet name
    
    ' Read dynamic data from Excel
    recipientName = ws.Range("A1").Value ' Change "A1" to the cell containing recipient's name
    recipientAddress = ws.Range("A2").Value ' Change "A2" to the cell containing recipient's address
    dateStr = ws.Range("A3").Value ' Change "A3" to the cell containing date
    apeAmount = ws.Range("A4").Value ' Change "A4" to the cell containing APE amount
    
    ' Initialize Word application
    Set wordApp = CreateObject("Word.Application")
    wordApp.Visible = True ' Set to True for debugging purposes, change to False to run in background
    
    ' Open the letter template
    Set wordDoc = wordApp.Documents.Open("C:\Path\To\Your\Template.docx") ' Change path to your template file
    
    ' Replace placeholders in the letter template with dynamic data
    With wordDoc.Content.Find
        .Text = "<Date>"
        .Replacement.Text = dateStr
        .Execute Replace:=wdReplaceAll
        .Text = "<RecipientName>"
        .Replacement.Text = recipientName
        .Execute Replace:=wdReplaceAll
        .Text = "<Address>"
        .Replacement.Text = recipientAddress
        .Execute Replace:=wdReplaceAll
        .Text = "<APEAmount>"
        .Replacement.Text = apeAmount
        .Execute Replace:=wdReplaceAll
    End With
    
    ' Save the letter as PDF
    wordDoc.SaveAs2 "C:\Path\To\Save\Letter.pdf", FileFormat:=17 ' Change path to save the PDF
    
    ' Close Word document
    wordDoc.Close
    
    ' Quit Word application
    wordApp.Quit
    
    ' Send email with the PDF attachment
    SendEmail "[email protected]", "Your Subject", "Your Body", "C:\Path\To\Save\Letter.pdf" ' Call SendEmail function with appropriate parameters

End Sub

Sub SendEmail(recipient As String, subject As String, body As String, attachmentPath As String)
    Dim outlookApp As Object
    Dim outlookMail As Object
    
    ' Initialize Outlook application
    Set outlookApp = CreateObject("Outlook.Application")
    
    ' Create a new email
    Set outlookMail = outlookApp.CreateItem(0)
    
    ' Fill email details
    With outlookMail
        .To = recipient
        .Subject = subject
        .Body = body
        .Attachments.Add attachmentPath
        .Send
    End With
    
    ' Release Outlook objects
    Set outlookMail = Nothing
    Set outlookApp = Nothing
End Sub