'How to apply font formatting to email (percentage and currency)?

I'm creating a file to review multiple franchises' financial information.

I want to create & send emails with similar body but different financial metrics pulled from each row. The file has data in columns A-S and each row contains data specific to each franchise. To the right of all of this is an inserted textbox that contains the body of the email.

  • Column A is a list of "franchise names".
  • Columns B:F will be the email addresses, each row having about 4 addresses add for each email.
  • Columns G:M are financial data that will be pulled into each email.
  • Lastly N:S are more financial metrics.

The operation is carried out through a button on the screen.

My issue is formatting in the email.

  • Figures in G:M need to be currency, in the email body it is unformatted.
  • Figures in N:S need to be %'s in the email body, they are also pulling unformatted.

enter image description here

Sub send_mass_email()

    Dim i As Integer
    Dim name, Email, Email2, GMEmail, body, subject, MTDRev, LMRev, SYSRevGrowth, MTDNMU, LMNMU, NMUChange, MTDLeads, LMLeads, LeadsChange, OSAvg, AvgNMU, AvgActivityMTD As String
    Dim OutApp As Object
    Dim OutMail As Object
    
    body = ActiveSheet.TextBoxes("TextBox 1").Text
    
    i = 2
    Do While Cells(i, 2).Value <> ""
        
        name = Cells(i, 2).Value
        Email = Cells(i, 3).Value
        Email2 = Cells(i, 4).Value
        GMEmail = Cells(i, 6).Value
        body = ActiveSheet.TextBoxes("TextBox 1").Text
        subject = Cells(i, 7).Value
        MTDRev = Cells(i, 8).Value
        LMRev = Cells(i, 9).Value
        SYSRevGrowth = Cells(i, 10).Value
        MTDNMU = Cells(i, 11).Value
        LMNMU = Cells(i, 12).Value
        NMUChange = Cells(i, 13).Value
        MTDLeads = Cells(i, 14).Value
        LMLeads = Cells(i, 15).Value
        LeadsChange = Cells(i, 16).Value
        OSAvg = Cells(i, 17).Value
        AvgNMU = Cells(i, 18).Value
        AvgActivityMTD = Cells(i, 19).Value

        body = Replace(body, "B2", name)
        body = Replace(body, "H2", MTDRev)
        body = Replace(body, "I2", LMRev)
        body = Replace(body, "J2", SYSRevGrowth)
        body = Replace(body, "K2", MTDNMU)
        body = Replace(body, "L2", LMNMU)
        body = Replace(body, "M2", NMUChange)
        body = Replace(body, "N2", MTDLeads)
        body = Replace(body, "O2", LMLeads)
        body = Replace(body, "P2", LeadsChange)
        body = Replace(body, "Q2", OSAvg)
        body = Replace(body, "R2", AvgNMU)
        body = Replace(body, "S2", AvgActivityMTD)
        body = Replace(body, "X2", Title)
        body = Replace(body, "Y2", Date)
        
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .to = Email
            .cc = Email2
            .bcc = GMEmail
            .subject = subject
            .body = body
            .Attachments.Add
            .Display
            .Send
        End With
    
        body = ActiveSheet.TextBoxes("TextBox 1").Text
    
        i = i + 1
    Loop
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    
    MsgBox "Email(s) Sent!"
    
End Sub


Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source