Untitled
unknown
plain_text
a year ago
2.8 kB
4
Indexable
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 "recipient@example.com", "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
Editor is loading...
Leave a Comment