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
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)
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.
How do I convert the script from an Mail_Object to HTML so that I can properly format line 3 and 4 to be bullet points and then change the font on line 5?
I know nothing about HTML.
The following code runs but does not do any formatting or bullet points.
Sub Sample_Auto_Generated_Email_Final()
Set Mail_Object = CreateObject("Outlook.Application")
With Mail_Object.CreateItem(o)
.Subject = "Report"
.To = "XX#Xx.com"
.Body = MAR_Message_5()
.Send
End With
End Sub
Function MAR_Message_5() As String
MAR_Message_5 = "Line1" & vbNewLine & _
"Line 2" & vbNewLine & _
" • Line3" & _
" • Line4" & vbNewLine & _
Chr(10) & _
"Line 5" <-- I want this line to be Calabri 6 point font.
End Function
I test your code, please change your code to the below code:
Sub Sample_Auto_Generated_Email_Final()
Set Mail_Object = CreateObject("Outlook.Application")
With Mail_Object.CreateItem(o)
.Subject = "Report"
.To = "XX#Xx.com"
.HTMLBody = MAR_Message_5()
.Send
End With
End Sub
Function MAR_Message_5() As String
MAR_Message_5 = "<span>Line1132323213123" & vbNewLine & "</span><br>"
MAR_Message_5 = MAR_Message_5 & "<span>Line2132323213123" & vbNewLine & "</span><br>"
MAR_Message_5 = MAR_Message_5 & "<span>????Line3132323213123" & vbNewLine & "</span><br>"
MAR_Message_5 = MAR_Message_5 & "<span>????Line4132323213123" & vbNewLine & "</span><br>"
MAR_Message_5 = MAR_Message_5 & "<span>........Line5132323213123" & vbNewLine & "</span>"
End Function
<br> label can switch to the next line.
This is my result:
Reference from:
Sending html email from VBA email program
I currently have a code in a database that sends an email with a table
The table currently is not formatted it correctly and Im unable to apply cell padding. Any ideas?
enter image description here
Here is the code accompanying it
Function exporthtml()
Dim strline, strHTML, strMsg
Dim Cnt As String
Dim strFilt As String
Dim ACname As String
Dim filt As String
Dim strCC As String
Cnt = DCount("[PATS Action ID]", "tblPAT", "Bureau='" & Form_frmMainPATS.cboBur.Value & "'")
ACname = DLookup("FIRSTNAME", "qryAC", "Bureau='" & Form_frmMainPATS.txtFull.Value & "'")
strFilt = DLookup("WORKEMAIL", "qryAC", "Bureau='" & Form_frmMainPATS.txtFull.Value & "'")
Dim OL As Outlook.Application
Set OL = New Outlook.Application
Set MyItem = Outlook.Application.CreateItem(olMailItem)
Report_rptCurrentPATS.Filter = "Bureau='" & Form_frmMainPATS.cboBur.Value & "'"
Report_rptCurrentPATS.FilterOn = True
DoCmd.OutputTo acOutputReport, "rptCurrentPATS", acFormatHTML, "R:\Epi- Admin\Administrative Collaboration\Admin Review Meetings\Weekly Administrative Reports\Working Documents\Bureau Status Report Updates\TEST.html"
Open "R:\Epi-Admin\Administrative Collaboration\Admin Review Meetings\Weekly Administrative Reports\Working Documents\Bureau Status Report Updates\TEST.html" For Input As 1
Do While Not EOF(1)
Input #1, strline
strHTML = strHTML & strline
Loop
Close 1
If Left(OL.Version, 2) = "10" Then
MyItem.BodyFormat = olFormatHTML
End If
MyItem.To = strFilt
MyItem.Subject = "Updated PATS Status Report as of " & Date - 1
MyItem.HTMLBody = "<BODY bgcolor='#E6E6FA'>" & "<img src='R:\Epi-Admin\Fiscal Management and Reporting Unit\Database\PS Database\logo.png' ALT='Banner'" & "<p>" & "<FONT color = '#000000'>" & "Dear " & ACname & "," & "<br/>" & "<br/>" & Form_frmMainPATS.cboBur.Value & " currently has " & Cnt & " pending personnel actions." & "</p>" & "<p>" & "Please see the report below:" & "<br/>" & "<BODY>" & "<table border= '1'>" & "<bgcolor=#ffffff; cellspacing=10; table-layout: fixed; >" & "<table header= '1' bgcolor='#fffff'>" & strHTML & "</table>" & "</br>" & "<br/>" & "</br>" & "</br>" & "<p> If you have any questions, please contact your desingated Personnel Coordinator"
MyItem.Display
End Function
Any help would be appreciated
Expanding on my comment from above, you can try to see if something like this works or gets you in the right direction (not tested):
Dim strCell() as string
Do While Not EOF(1)
Input #1, strline
strCell() = Split(strline, vbTab) 'Replace vbTab with deliminator if needed
dim i as integer
for i = 0 to UBound(strCell)
strline = "<td>" & strCell(i) & "</td>"
next
strHTML = strHTML & "<tr>" & strline & "</tr>"
Loop
Close 1
I have been trying to send a email via excel and use html in the message body but it seems excel does not reconize de <\li>. I have the microsoft html Oject library added.
Sub send()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "dupma4"
'.CC = "Patrick.Blouin#mern.gouv.qc.ca;Veronic.Cinq-Mars#mern.gouv.qc.ca"
.BCC = ""
.Subject = "Ajouts d'adresse | [" & mun & " " & ville & "] | [" & Format(Now(), "yyyy-MM-dd") & "]"
.HTMLBody = "Bonjour," & "<br>" & "<br>" _
& "<ul>" & "<li> & message1 & "</li>" & "<li>" & message2 _
& "</li>" & "</ul>"
'.Send
End With
End Sub
You're missing an ending quotation mark (") for your first li. So it should be as follows...
.HTMLBody = "Bonjour," & "<br>" & "<br>" _
& "<ul>" & "<li>" & message1 & "</li>" & "<li>" & message2 _
& "</li>" & "</ul>"
I'm trying to add an If-Then statement to my VBA in order to create two different email texts based on whether a specific field is populated in a table.
If no data is in the [VendorID/UIN] field in the t1stNoticeEmails table, I'd like this text:
"Please provide a current remit-to address as soon as possible so we can resend the check(s) to the intended recipient(s). The funds from this check will remain as a charge against the FOAPALs utilized in the transaction until this matter is resolved."
If there is data in the [VendorID/UIN] field in the t1stNoticeEmails table, I'd like this additional text:
"In addition, the Vendor ID associated with this transaction may need to be updated. Please contact Vendor Maintenance."
Here's the code:
Sub FirstEmail_IncorrectAddress_ReviewVBA()
Dim rst As DAO.Recordset
Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem
Dim rst2 As DAO.Recordset
Dim strTableBeg As String
Dim strTableBody As String
Dim strTableEnd As String
Dim strFntNormal As String
Dim strTableHeader As String
Dim strFntEnd As String
Dim CheckNum As String
Dim NameOfRecipient As String
Dim StrSQL1 As String
Dim NameSpaceOutlook As Outlook.Namespace
gPARAttachment = "S:\...."
'SEND FIRST NOTICE EMAILS'
'------------------'
Set rst2 = CurrentDb.OpenRecordset("select distinct ContactEmails from t1stNoticeEmails WHERE CheckReturnReason = 'IncorrectAddress'")
If rst2.RecordCount = 0 Then 'checks if recordset returns any records and continues if records found and exits if no records found
Exit Sub
End If
rst2.MoveFirst
'Create e-mail item
Set olApp = Outlook.Application
Set objMail = olApp.CreateItem(olMailItem)
'Do Until rst2.EOF
Set olApp = Outlook.Application
Set objMail = olApp.CreateItem(olMailItem)
'Define format for output
strTableBeg = "<table border=1 cellpadding=3 cellspacing=0>"
strTableEnd = "</table>"
strTableHeader = "<font size=3 face='Calibri'><b>" & _
"<tr bgcolor=#4DB84D>" & _
td("CheckNumber") & _
td("PayeeName") & _
td("VendorID") & _
td("DocNo / ERNo / PONo") & _
td("Amount") & _
td("CheckDate") & _
td("OriginalCheckAddress1") & _
td("OriginalCheckAddress2") & _
td("OriginalCheckCity") & _
td("OriginalCheckState") & _
td("OriginalCheckZip") & _
"</tr></b></font>"
strFntNormal = "<font color=black face='Calibri' size=3>"
strFntEnd = "</font>"
Set rst = CurrentDb.OpenRecordset("SELECT * FROM t1stNoticeEmails where ContactEmails='" & rst2!ContactEmails & "' AND CheckReturnReason = 'IncorrectAddress' Order by FullName asc")
If rst.RecordCount = 0 Then
rst2.Close
Set rst2 = Nothing
Exit Sub
End If
rst.MoveFirst
NameOfRecipient = rst!FullName
CheckNum = rst!CheckNumber
'Build HTML Output for the DataSet
strTableBody = strTableBeg & strFntNormal & strTableHeader
Do Until rst.EOF
strTableBody = _
strTableBody & _
"<tr>" & _
"<TD nowrap>" & rst!CheckNumber & "</TD>" & _
"<TD nowrap>" & rst!FullName & "</TD>" & _
"<TD nowrap>" & rst![VendorID/UIN] & "</TD>" & _
"<TD nowrap>" & rst![DocNo / ERNo / PONo] & "</TD>" & _
"<TD align='right' nowrap>" & Format(rst!AmountDue, "currency") & "</TD>" & _
"<TD nowrap>" & rst!OriginalCheckDate & "</TD>" & _
"<TD align='left' nowrap>" & rst!OriginalCheckAddress1 & "</TD>" & _
"<TD align='left' nowrap>" & rst!OriginalCheckAddress2 & "</TD>" & _
"<TD align='left' nowrap>" & rst!OriginalCheckCity & "</TD>" & _
"<TD align='left' nowrap>" & rst!OriginalCheckState & "</TD>" & _
"<TD align='left' nowrap>" & rst!OriginalCheckZip & "</TD>" & _
"</tr>"
rst.MoveNext
Loop
'rst.MoveFirst
strTableBody = strTableBody & strFntEnd & strTableEnd
'rst.Close
'Set rst2 = CurrentDb.OpenRecordset("select distinct ch_email from t_TCard_CH_Email")
'rst2.MoveFirst
Call CaptureIABodyText
With objMail
'Set body format to HTML
.To = rst2!ContactEmails
.BCC = gIAEmailBCC
.Subject = gIAEmailSubject & " - Check# " & CheckNum & " - " & NameOfRecipient
.BodyFormat = olFormatHTML
.HTMLBody = .HTMLBody & gIABodyText
.HTMLBody = .HTMLBody & "<HTML><BODY>" & strFntNormal & strTableBody & " </BODY></HTML>"
.HTMLBody = .HTMLBody & gIABodySig
.SentOnBehalfOfName = ""
.Display
'.Send
End With
rst2.MoveNext
'Loop
rst.Close
Set rst = Nothing
rst2.Close
Set rst2 = Nothing
End Sub
This will give you an additional variable sAdditionalText that you can concatenate to your main string wherever you want:
Dim sAdditionalText As String
If IsNull(rst![VendorID/UIN]) Then
sAdditionalText = "Please provide a current remit-to address as soon as possible so we can resend the check(s) to the intended recipient(s). The funds from this check will remain as a charge against the FOAPALs utilized in the transaction until this matter is resolved."
Else
sAdditionalText = "In addition, the Vendor ID associated with this transaction may need to be updated. Please contact Vendor Maintenance."
End If