htmlvbaoutlookms-word

Formatting automated word file


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

Solution

  • 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:

    Selection object (Word)

    Selection.Collapse method (Word)