I am trying to automate creating and sending a word file through outlook but the formatting (font size, font style, alignment) is not applied. The excel table I used was just two columns, one for the emails, the other for the payment.
This code creates a word file that informs the client of his payment, then sends the file through outlook to email found in column A.
Sub SendEmail()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim ws As Worksheet
Dim rngEmails As Range
Dim cell As Range
Dim strFolderPath As String
Dim strFilePath As String
Dim fileName As String
Dim name As String
' Specify the folder path where the Word files will be saved
strFolderPath = "C:\Users\VBA\WordFiles\"
' Create Outlook application object
Set OutlookApp = CreateObject("Outlook.Application")
' Set the worksheet where email addresses and payments are located
Set ws = ThisWorkbook.Sheets("Feuil1") ' Replace "Feuil1" with the actual sheet name
' Find the last row with data in column A
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' Loop through each cell in the range
For Each cell In ws.Range("A2:A" & lastRow)
' Check if the cell is not empty and contains a valid email address
If Not IsEmpty(cell.Value) And IsValidEmail(cell.Value) Then
' Get the payment value from column B
Dim paymentAmount As Variant
paymentAmount = ws.Cells(cell.Row, "B").Value
' Extract the name from the email address
name = Split(cell.Value, "@")(0)
' Generate the file name
fileName = "Payment_" & name & ".docx"
' Create a new Word document
Dim wordApp As Object
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = False ' Set to True if you want to see Word
' Create a new document
Dim doc As Object
Set doc = wordApp.Documents.Add
' Set font size and style
With doc.Content
.Font.Size = 12
.Font.Bold = True
.ParagraphFormat.Alignment = 3 ' Center alignment
.InsertAfter "Dear " & name & "," & vbCrLf & vbCrLf
.Font.Size = 11
.Font.Bold = False
.ParagraphFormat.Alignment = 0 ' Left alignment
.InsertAfter "We are pleased to inform you that your monthly payment for the amount of $" & paymentAmount & " is ready for processing." & vbCrLf & vbCrLf
.InsertAfter "Please find the details below:" & vbCrLf & vbCrLf
.Font.Bold = True
.InsertAfter "Payment Details:" & vbCrLf
.Font.Bold = False
.InsertAfter "- Amount: $" & paymentAmount & vbCrLf & vbCrLf
.InsertAfter "Kind regards," & vbCrLf & "Your Company"
End With
' Save the document
strFilePath = strFolderPath & fileName
doc.SaveAs2 strFilePath
doc.Close
' Send email with the created Word document
Set OutlookMail = OutlookApp.CreateItem(0) ' 0 represents an email item
With OutlookMail
.To = cell.Value ' Set the recipient to the email address in the current cell
.Subject = "Monthly Payment Details" ' Set the subject of the email
.Body = "Dear " & name & "," & vbCrLf & vbCrLf & _
"Please find your monthly payment details attached." & vbCrLf & vbCrLf & _
"Kind regards," & vbCrLf & "Your Company" ' Set the email body text
.Attachments.Add strFilePath ' Attach the Word document
.Send ' Send the email immediately
End With
Set OutlookMail = Nothing
' Close Word application
wordApp.Quit
Set wordApp = Nothing
End If
Next cell
' Clean up objects
Set OutlookApp = Nothing
End Sub
Function IsValidEmail(emailAddress As String) As Boolean
' Use a regular expression to check if the email address is valid
Dim regex As Object
Set regex = CreateObject("VBScript.RegExp")
regex.Pattern = "^[\w\.-]+@[a-zA-Z\d\.-]+\.[a-zA-Z]{2,}$"
IsValidEmail = regex.Test(emailAddress)
End Function
Style changes inside With doc.Content affect the entire Word document, overriding previous settings. The last changes remain applied (Bold=False,Size=11 and so on).
With doc.ActiveWindow.Selection
.Font.Size = 12
.Font.Bold = True
.ParagraphFormat.Alignment = 3 ' Center alignment
.InsertAfter "Dear " & name & "," & vbCrLf & vbCrLf
.Collapse 0
.Font.Size = 11
.Font.Bold = False
.ParagraphFormat.Alignment = 0 ' Left alignment
.InsertAfter "We are pleased to inform you that your monthly payment for the amount of $" & paymentAmount & " is ready for processing." & vbCrLf & vbCrLf
.InsertAfter "Please find the details below:" & vbCrLf & vbCrLf
.Collapse 0
.Font.Bold = True
.InsertAfter "Payment Details:" & vbCrLf
.Collapse 0
.Font.Bold = False
.InsertAfter "- Amount: $" & paymentAmount & vbCrLf & vbCrLf
.InsertAfter "Kind regards," & vbCrLf & "Your Company"
End With
Microsoft reference document: