'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.
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 |
|---|

