I tried to create a vba codes to help me send emails to different clients.

I put all email body in a text box in excel with specific formatting. The issue I have now is when the email body inserted into an email the body format got lost.

Question : How can I keep the format of the text box?

Sub test_email_template()
    Dim name, email, body, subject, copy, place, business As String
    
    
    name = Range("B4").Value
    email = Range("C4").Value
    body = Format(ActiveSheet.TextBoxes("TextBox 1").Text)
    subject = " Payment Summary Reports"
    copy = Range("D2").Value
   
'replace name'
body = Replace(body, "Email Title", name)


Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
    
         .to = email
         .cc = copy
         .subject = subject
         .body = body
         
         .display
        
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
    MsgBox "Email(s) Sent!"
End Sub

Below is the text box format I want to keep

CodePudding user response：

you would need to use .htmlbody. The idea is to write your message in excel cell with html, for example:

<p><font font face="Arial">Dear Email Title</p>
<p><font font face="Arial">Attached please find your up to date Payment Summary Reports.</p>
<p><font font face="Arial">Kind regards</p>
<p><font font face="Arial">John Johns</p>

Just put this in excel cell as your copy/paste body and then do the replace and put this text in .htmlbody = body

CodePudding user response：

You can use the following code to copy the text with formatting. Of course you'd need to make changes to this code to accommodate your requirements.

but xlSheet.Range("C1:C2").copy is the important code to copy cell text to clipboard with the Rich Text format.

You can have the

• salutation (Deal Email Title) in cell C1 as a formula so that it can be updated using formula.
• rest of the body with Rich Text formatting in Cell C2

Reference: Copying clipboard content into outlook mail item using VBA

Dim OutApp As Object
Dim OutMail As Object
Dim olInsp As Object
Dim xlSheet As Worksheet
Dim wdDoc As Object
Dim oRng As Object
    Set xlSheet = ActiveWorkbook.Sheets("Sheet1")
    xlSheet.Range("C1:C2").copy

    On Error Resume Next
    Set OutApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application")
    On Error GoTo 0
    
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .BodyFormat = 3
        .To = ""
        .CC = ""
        .BCC = ""
        .subject = "Your Subject here"
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        oRng.collapse 1
        oRng.Paste
        .Display
    End With
   
 
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Set OutMail = Nothing
    Set OutApp = Nothing
    'MsgBox "Email(s) Sent!"