How to change the color of replacement text as html in VBA
Question
I'm trying to change the color of the variable text "full_name" to bold blue and "replace_week_number" to bold red in the code below. Also I'd like to add a line between J1 and J2 and the table. I have to do this for two of our other locations so I'd like it to be perfect the first time.
I'm very new to VBA and HTML and not familiar with proper syntax needed to achieve this. I have tried several things to change the colors but was unsuccessful. I also added in the extra line between J1 and J2 but they didn't come out that way in the emails I was testing.
Sub SendEmail(what_address As String, subject_line As String, mail_body As String)
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")
Dim olMail As Outlook.MailItem
Set olMail = olApp.CreateItem(olMailItem)
olMail.To = what_address
olMail.Subject = subject_line
olMail.HTMLbody = mail_body
olMail.Send
End Sub
Sub SendSchedules()
row_number = 3
Do
DoEvents
row_number = row_number + 1
Dim mail_body_message As String
Dim full_name As String
Dim replace_Monday As String
Dim replace_Tuesday As String
Dim replace_Wednesday As String
Dim replace_Thursday As String
Dim replace_Friday As String
Dim replace_Saturday As String
Dim replace_Sunday As String
Dim StrBody As String
full_name = ActiveSheet.Range("A" & row_number)
mon_day = ActiveSheet.Range("B" & row_number)
tues_day = ActiveSheet.Range("C" & row_number)
wednes_day = ActiveSheet.Range("D" & row_number)
thurs_day = ActiveSheet.Range("E" & row_number)
fri_day = ActiveSheet.Range("F" & row_number)
satur_day = ActiveSheet.Range("G" & row_number)
sun_day = ActiveSheet.Range("H" & row_number)
week_number = ActiveSheet.Range("K2")
mail_body_message = Replace(mail_body_message, "replace_name_here", full_name)
mail_body_message = Replace(mail_body_message, "replace_week_number", week_number)
mail_body_message = Replace(mail_body_message, "replace_Monday", mon_day)
mail_body_message = Replace(mail_body_message, "replace_Tuesday", tues_day)
mail_body_message = Replace(mail_body_message, "replace_Wednesday", wednes_day)
mail_body_message = Replace(mail_body_message, "replace_Thursday", thurs_day)
mail_body_message = Replace(mail_body_message, "replace_Friday", fri_day)
mail_body_message = Replace(mail_body_message, "replace_Saturday", satur_day)
mail_body_message = Replace(mail_body_message, "replace_Sunday", sun_day)
StrBody = "<html> <head> <style> br, table, table style {background-color: transparent;table background: url(https://imgur.com/a/Yg8oqcn);width: 325px;height: 315px;border: 1px solid black}, th {bpadding: 1px; border: 1px solid black;alignment: center}, td {bpadding: 3px; border: 1px solid black;alignment: center} </style> <head> <body> <table>"
mail_body_message = ActiveSheet.Range("J1") & " " & vbNewLine & " " & ActiveSheet.Range("J2") & " " & vbNewLine & " " & StrBody & vbNewLine & _
"<tr>" & _
"<th>" & ActiveSheet.Range("B3") & "</th>" & _
"<th>" & ActiveSheet.Range("B2") & "</th>" & _
"<td>" & mon_day & "</td></tr>" & _
"<th>" & ActiveSheet.Range("C3") & "</th>" & _
"<th>" & ActiveSheet.Range("C2") & "</th>" & _
"<td>" & tues_day & "</td></tr>" & _
"<th>" & ActiveSheet.Range("D3") & "</th>" & _
"<th>" & ActiveSheet.Range("D2") & "</th>" & _
"<td>" & wednes_day & "</td></tr>" & _
"<th>" & ActiveSheet.Range("E3") & "</th>" & _
"<th>" & ActiveSheet.Range("E2") & "</th>" & _
"<td>" & thurs_day & "</td></tr>" & _
"<th>" & ActiveSheet.Range("F3") & "</th>" & _
"<th>" & ActiveSheet.Range("F2") & "</th>" & _
"<td>" & fri_day & "</td></tr>" & _
"<th>" & ActiveSheet.Range("G3") & "</th>" & _
"<th>" & ActiveSheet.Range("G2") & "</th>" & _
"<td>" & satur_day & "</td></tr>" & _
"<th>" & ActiveSheet.Range("H3") & "</th>" & _
"<th>" & ActiveSheet.Range("H2") & "</th>" & _
"<td>" & sun_day & "</td></tr>" & _
"</table>"
mail_body_message = Replace(mail_body_message, "replace_name_here", full_name)
mail_body_message = Replace(mail_body_message, "replace_week_number", week_number)
Call SendEmail(ActiveSheet.Range("I" & row_number), ActiveSheet.Range("L1"), mail_body_message)
Loop Until row_number = 74
End Sub
2 answers
solution1
0 ACCPTED 2019-01-25 01:17:28
Replace:
mail_body_message = Replace(mail_body_message, "replace_name_here", full_name)
and
mail_body_message = Replace(mail_body_message, "replace_week_number", week_number)
with
mail_body_message = Replace(mail_body_message, "replace_name_here", "<span style=" &"""" & "color: #0000ff;" & """" & " full_name & ">")
and
mail_body_message = Replace(mail_body_message, "replace_week_number", "<span style=" &"""" & "color: #ff0000;" & """" & " week_number & ">")
To set a line space, you could use the tag
<br/>
(maybe twice)
solution2
0 2019-02-23 01:43:41
Based on your information and your provided code I have tried to understand your scenario.
Going through your provided code, I have ended up with some questions and comments.
Also based on my asumtions of your scenario I have made a suggestion of how to solve the task. I might have missunderstand your scenario and if so is the case I still hope the suggested code will help in building your solution.
For your concreet questions about HTML (email) formatting I have provided two tools I've made and that I use myself for similar tasks. One is a simple string builder that will make the task of building the HTML-text/code much easier and more controllable. Second is a function to format text in HTML-texts with color, background color and font weight.
Questions and comments to your provided code:
Sub SendEmail(what_address As String, subject_line As String, mail_body As String)
Dim olApp As New Outlook.Application ' New was missing...
Set olApp = CreateObject("Outlook.Application")
Dim olMail As Outlook.MailItem
Set olMail = olApp.CreateItem(olMailItem)
olMail.To = what_address
olMail.Subject = subject_line
olMail.HTMLbody = mail_body
olMail.Send
End Sub 'SendEmail
Sub SendSchedules()
' COMMENT: This parameter is not declared. -----
row_number = 3
Do
DoEvents
row_number = row_number + 1
Dim mail_body_message As String
Dim full_name As String
' COMMENT: These are never used... -------------
Dim replace_Monday As String
Dim replace_Tuesday As String
Dim replace_Wednesday As String
Dim replace_Thursday As String
Dim replace_Friday As String
Dim replace_Saturday As String
Dim replace_Sunday As String
'-----------------------------------------------
Dim StrBody As String
' COMMENT: Here follows parameters that are not declared. -----
full_name = ActiveSheet.Range("A" & row_number)
mon_day = ActiveSheet.Range("B" & row_number)
tues_day = ActiveSheet.Range("C" & row_number)
wednes_day = ActiveSheet.Range("D" & row_number)
thurs_day = ActiveSheet.Range("E" & row_number)
fri_day = ActiveSheet.Range("F" & row_number)
satur_day = ActiveSheet.Range("G" & row_number)
sun_day = ActiveSheet.Range("H" & row_number)
week_number = ActiveSheet.Range("K2")
'--------------------------------------------------------------
' COMMENTS:------------------------------------------------------------------------------------
' Why is this done?
' At this stage will not the parameter mail_body_message be an empty string?
' Will this do anything at all?
mail_body_message = Replace(mail_body_message, "replace_name_here", full_name)
mail_body_message = Replace(mail_body_message, "replace_week_number", week_number)
mail_body_message = Replace(mail_body_message, "replace_Monday", mon_day)
mail_body_message = Replace(mail_body_message, "replace_Tuesday", tues_day)
mail_body_message = Replace(mail_body_message, "replace_Wednesday", wednes_day)
mail_body_message = Replace(mail_body_message, "replace_Thursday", thurs_day)
mail_body_message = Replace(mail_body_message, "replace_Friday", fri_day)
mail_body_message = Replace(mail_body_message, "replace_Saturday", satur_day)
mail_body_message = Replace(mail_body_message, "replace_Sunday", sun_day)
'-----------------------------------------------------------------------------------------------
StrBody = "<html> <head> <style> br, table, table style {background-color: transparent;table background: url(https://imgur.com/a/Yg8oqcn);width: 325px;height: 315px;border: 1px solid black}, th {bpadding: 1px; border: 1px solid black;alignment: center}, td {bpadding: 3px; border: 1px solid black;alignment: center} </style> <head> <body> <table>"
mail_body_message = ActiveSheet.Range("J1") & " " & vbNewLine & " " & ActiveSheet.Range("J2") & " " & vbNewLine & " " & StrBody & vbNewLine & _
"<tr>" & _
"<th>" & ActiveSheet.Range("B3") & "</th>" & _
"<th>" & ActiveSheet.Range("B2") & "</th>" & _
"<td>" & mon_day & "</td></tr>" & _
"<th>" & ActiveSheet.Range("C3") & "</th>" & _
"<th>" & ActiveSheet.Range("C2") & "</th>" & _
"<td>" & tues_day & "</td></tr>" & _
"<th>" & ActiveSheet.Range("D3") & "</th>" & _
"<th>" & ActiveSheet.Range("D2") & "</th>" & _
"<td>" & wednes_day & "</td></tr>" & _
"<th>" & ActiveSheet.Range("E3") & "</th>" & _
"<th>" & ActiveSheet.Range("E2") & "</th>" & _
"<td>" & thurs_day & "</td></tr>" & _
"<th>" & ActiveSheet.Range("F3") & "</th>" & _
"<th>" & ActiveSheet.Range("F2") & "</th>" & _
"<td>" & fri_day & "</td></tr>" & _
"<th>" & ActiveSheet.Range("G3") & "</th>" & _
"<th>" & ActiveSheet.Range("G2") & "</th>" & _
"<td>" & satur_day & "</td></tr>" & _
"<th>" & ActiveSheet.Range("H3") & "</th>" & _
"<th>" & ActiveSheet.Range("H2") & "</th>" & _
"<td>" & sun_day & "</td></tr>" & _
"</table>"
' COMMENT: Why is this done? Both full_name and week_number is defined previously in the code. -------
' Why not use them directly where they are needed in the email?
mail_body_message = Replace(mail_body_message, "replace_name_here", full_name)
mail_body_message = Replace(mail_body_message, "replace_week_number", week_number)
'-----------------------------------------------------------------------------------------------------
Call SendEmail(ActiveSheet.Range("I" & row_number), ActiveSheet.Range("L1"), mail_body_message)
Loop Until row_number = 74
End Sub 'SendSchedules
My suggestion to solve the task is based on the following assumption of your excel sheet: Snapshot of sheet setup
My suggestion code for SendSchedules():
Sub SendSchedules()
Dim row_number As Integer
Dim sb As New jlStringBuilder 'Defining a string builder which will make the construction of the HTML-text easier.
sb.DefaultLineShift = "<br/>" 'Defining the string builder line break as <br/> since we will use it only for HTML.
For row_number = 4 To 74 'iterat through row 4 to 74
'DoEvents
Dim full_name As String
Dim week_number As String
full_name = ActiveSheet.Range("A" & row_number)
week_number = ActiveSheet.Range("K2")
sb.Clear 'resets the stringbuilder for new email.
'Start building the email's HTMLtext.
sb.AddLine "<html>"
sb.Add "<head>"
sb.Add "<style>"
sb.Add "table {"
sb.Add "background-color: transparent;"
sb.Add "table background: url(https://i.imgur.com/RUwLFqH.png);" 'Don't think this will work...
sb.Add "width: 325px;"
sb.Add "height: 315px;"
sb.Add "border-collapse: collapse;"
sb.Add "border: 1px solid black;"
sb.Add "},"
sb.Add "th {"
sb.Add "padding: 1px;"
sb.Add "text-align: left;"
sb.Add "border: 1px solid black;"
sb.Add "},"
sb.Add "td {"
sb.Add "padding: 3px;"
sb.Add "text-align : center;"
sb.Add "border: 1px solid black;"
sb.Add "}"
sb.Add "</style>"
sb.Add "</head>"
sb.Add "<body>"
'Moved the following to the inside of the HTML code since the whole email text will be delivered as HTML to olMail.HTMLbody:
'Adding the full_name and week_number so it will apear at the top of the email.
'Using GetColoredHTMLstring to add color and font weight.
sb.AddLine GetColoredHTMLstring(full_name, "#0000ff", "", "bold") 'blue and bold font
sb.AddLine "Week number: "
sb.Add GetColoredHTMLstring(week_number, "#ff0000", "", "") 'red font
'COMMENT: I'm guessing this will equal ActiveSheet.Range("J1") and ActiveSheet.Range("J2") in the original setup?
' Start building our table.
sb.AddLine "<table>"
'Iterating through each range with weekday/chedule data and adding the headings and data rows and columns to the table.
Dim i As Integer
For i = 2 To 8 'the chedule data is in column 2 (B) to 8 (H).
sb.Add "<tr>"
sb.Add "<th>" & ActiveSheet.Cells(3, i) & "</th>" 'Day header 2
sb.Add "<th>" & ActiveSheet.Cells(2, i) & "</th>" 'Day header 1
sb.Add "<td>" & ActiveSheet.Cells(row_number, i) & "</td>" 'Day info
sb.Add "</tr>"
Next
'Explanation of what's going on in the loop above:
'Register info for monday.
'"B3" = Cells(3,2)
'"B2" = Cells(2,2)
'mon_day = Cells(2, row_number)
''Register info for tuesday.
'"C3" = Cells(3,3)
'"C2" = Cells(2,3)
'tues_day = Cells(3, row_number)
''Register info for wednesday.
'"D3" = Cells(3,4)
'"D2" = Cells(2,4)
'wednes_day = Cells(4, row_number)
' ...and so on... throught to Range(8,...
'Setting end tags for our email HTMLtext.
sb.Add "</table>" 'end table
sb.Add "</body>" 'end body
sb.Add "</html>" 'end html
'The stringbuilder will now contain the full HTML email, and we pass it to the SendEmail method
'toghether with the email address and the email subject.
Call SendEmail(ActiveSheet.Range("I" & row_number), ActiveSheet.Range("L1"), sb.ToString)
Next 'row_number
End Sub 'SendSchedules
The following function is used to format / color HTML-text. You must paste this into you project. Either in a new module or in the same module as the SendSchedules() method.
'// Function to render a text packed inside a html <span> tag which has
'// a style attribute defining the text color, text background color and
'// font weight.
Public Function GetColoredHTMLstring(text As String, color As String, backgrColor As String, fontWeigh As String) As String
Dim sb As New jlStringBuilder
sb.AddLine "<span style=" & Chr(34)
If Len(backgrColor) > 0 Then
sb.Add "background-color:"
sb.Add backgrColor
sb.Add ";"
End If
If Len(color) > 0 Then
sb.Add "color:"
sb.Add color
sb.Add ";"
End If
If Len(fontWeigh) > 0 Then
sb.Add "font-weight:"
sb.Add fontWeigh
sb.Add ";"
End If
sb.Add Chr(34) & ">"
sb.Add text
sb.Add "</span>"
GetColoredHTMLstring = sb.ToString
End Function 'GetColoredHTMLstring
The suggested code to solve the task uses a string builder class. To implement this, make a new class in your project and name it jlStringBuilder. Then paste the following code into the new class:
Option Explicit
'//-----------------------------
'// Code by Jan Lægreid - 2018
'//-----------------------------
'// Updated: 01.11.2018
'//-----------------------------
'// Class for a string builder object that can
'// be used to build a text in a structured way.
Private totalString As String
Private defaultLS As String
'// Property to set the default lineshift for the string builder..
Property Get DefaultLineShift() As String
DefaultLineShift = defaultLS
End Property
Property Let DefaultLineShift(lineShift As String)
defaultLS = lineShift
End Property
Private Sub Class_Initialize()
'If not spesified, default line shift will default to Chr(13).
defaultLS = Chr(13)
End Sub
'// Appends a string.
Public Sub Add(text As String)
totalString = totalString & text
End Sub
'// Adds a line with line shift.
'// Parameters:
'// textLine : string to be added.
'// lineShift: spesifies the line shift if it should be different than the default sat for the string
'// builder. Default is sat by property DefaultLineShift, and defautls to Chr(13) if not
'// spesified. Sometimes when building a string one might need a different line shift than
'// the one sat as default for the string builder. For example one would want "<br> if some
'// of the text is HTML, or if eg. Chr(10) should be used in stead of Chr(13) some place in
'// the text.
Public Sub AddLine(Optional textLine As String = "", Optional lineShift As String = "")
If Len(lineShift) = 0 Then lineShift = defaultLS
If Len(totalString) > 0 Then textLine = lineShift & textLine
totalString = totalString & textLine
End Sub
'// Retruns the total build string.
Function ToString() As String
ToString = totalString
End Function
'// Returns the total build string as an array.
Function ToArray() As String()
ToString = Split(totalString, defaultLS)
End Function
'// Clears the string builder.
Public Sub Clear()
totalString = ""
End Sub
Hope this was to some help.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.
Related Question
how to change color of auto text typing in html
How to change the color of the text here in this HTML file?
How to change the color of selected text in the HTML page?
How to change button text color on hover HTML
Change color text in select html
Html text color change on click
Color change of the selected text in HTML
Change background and text color in HTML
How to color html text?
How to change text color in HTML table with angularjs or jQuery?
Related Tags