我正在尝试将变量文本“full_name”的颜色更改为粗体蓝色，并将“replace_week_number”更改为下面的代码中的粗体红色。另外，我想在J1和J2以及表格之间添加一条线。我必须在其他两个地方这样做，所以我希望它第一次完美。
我对VBA和HTML很新，并且不熟悉实现此目的所需的正确语法。我尝试了几种改变颜色的东西，但没有成功。我还添加了J1和J2之间的额外行，但它们并没有在我测试的电子邮件中出现。
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
更换：
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_name_here", "<span style=" &"""" & "color: #0000ff;" & """" & " full_name & ">")
和
mail_body_message = Replace(mail_body_message, "replace_week_number", "<span style=" &"""" & "color: #ff0000;" & """" & " week_number & ">")
要设置行间距，可以使用标记
<br/>
（也许两次）
根据您的信息和您提供的代码，我试图了解您的方案。
通过提供的代码，我最后得到了一些问题和评论。
同样基于我对你的场景的影响，我已经提出了如何解决任务的建议。我可能会误解您的情况，如果是这样的话，我仍然希望建议的代码有助于构建您的解决方案。
对于你关于HTML（电子邮件）格式的concreet问题，我提供了两个我已经制作的工具，并且我将自己用于类似的任务。一个是简单的字符串构建器，它将使构建HTML文本/代码的任务更容易和更可控。第二个是在HTML文本中格式化文本的功能，具有颜色，背景颜色和字体粗细。
对您提供的代码提出的问题和评论：
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
我解决这个任务的建议是基于你的excel表的以下假设：Snapshot of sheet setup
我的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
以下函数用于格式化/着色HTML文本。您必须将其粘贴到项目中。在新模块中或与SendSchedules（）方法相同的模块中。
'// 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
解决任务的建议代码使用字符串构建器类。要实现此功能，请在项目中创建一个新类，并将其命名为jlStringBuilder。然后将以下代码粘贴到新类中：
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
希望这是一些帮助。