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.
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 am attempting to read a text file that contains rows and then output them in the form of columns in an html file. I have no problem having this work when using WScript.echo to display it on the screen, but I am unable to get it to a table in an HTML file. I am getting the following error when attempting to run the vbs file: Type mismatch: 'OpenTextFile'. Any guidance would be much appreciated
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim OutputHTML : Set OutputHTML = fso.CreateTextFile("C:\Users\Istaley.RXDATA\Desktop\NewEmployeeTest\Part2_TableData.html")
Dim file : Set file = fso.OpenTextFile("C:\Users\Istaley.RXDATA\Desktop\NewEmployeeTest\Part2_data.txt", 1, True)
Dim fc : fc = file.ReadAll : file.close : Dim fcArray : fcArray = Split(fc, vbCrLf)
OutputHTML.WriteLine "<html>"
OutputHTML.Writeline "<body>"
OutputHTML.WriteLine "<table BORDER=1>"
Dim opArray() : ReDim opArray(0)
For Each row In fcArray
Dim tmp: tmp = Split(row, "|")
For ent=0 To UBound(tmp)
If ent > UBound(opArray) Then
ReDim Preserve opArray(UBound(opArray)+1)
opArray(ent) = Trim(tmp(ent))
Else
If Len(opArray(ent)) > 0 Then
OutputHTML.WriteLine "<tr>"
opArray(ent) = opArray(ent) & " " & Trim(tmp(ent))
OutputHTML.WriteLine "</tr>"
Else
opArray(ent) = Trim(tmp(ent))
End If
End If
Next
Next
WScript.echo Join(opArray, vbCrLf)
OutputHTML.WriteLine "</table>"
OutputHTML.WriteLine "</body>"
OutputHTML.WriteLine "</html>"
OutputHTML.Write Join(opArray, vbCrLf) : OutputHTML.Close
I know it's an old topic, but this might be useful to anyone looking to do the same, like I did. It's a bit rushed, but I've added comments inline. Bits have been taken from a number of locations, so it's not all my own work...
Function LoadFile(File)
On Error Resume Next
'Declaire all variables
Dim fso,F,ReadText,strError
Dim ReadArray
Dim ReadHTMLOutput, ReadRowCount, ReadRowItem, ReadRowItemSplit, ReadElementCount, ReadElementItem
'Create the object to read files
Set fso = CreateObject("Scripting.FileSystemObject")
'Set the file to read and the format
Set F = fso.OpenTextFile(File,1)
'If there's a problem, say so...
If Err.Number <> 0 Then
strError = "<center><b><font color=Red>The file "& File &" dosen't exists !</font></b></center>"
OutputTable.InnerHTML = strError
Exit Function
End If
'Read the contents of the file into ReadText
ReadText = F.ReadAll
'Split the text based on Carriage return / Line feed
ReadArray = Split(ReadText,vbCrLf)
'fill the output variable with the HTML of the start of the table
ReadHTMLOutput = "<table border=" & chr(34) & "2" & chr(34) & ">" & vbcrlf
'starting at 0 until the last line in the array, run through each line
For ReadRowCount=0 to UBound(ReadArray)
'Take the whole row into it's own variable
ReadRowItem = ReadArray(ReadRowCount)
'Split the row (separated by commas) into an array
ReadRowItemSplit = Split(ReadRowItem,",")
'Add the HTML for the row of the table
ReadHTMLOutput = ReadHTMLOutput & "<tr>" & vbcrlf
'starting at 0 until the last entry of the row array, run through each element
For ReadElementCount=0 to UBound(ReadRowItemSplit)
'Read the element into a variable
ReadElementItem = ReadRowItemSplit(ReadElementCount)
'If the element is blank, put a space in (stops the cell being formatted empty)
If ReadElementItem = "" Then ReadElementItem = " "
'Add the HTML for the cell of the row of the table
ReadHTMLOutput = ReadHTMLOutput & "<td>" & ReadElementItem & "</td>" & vbcrlf
'Go to the next element in the row
Next
'Add the HTML for the end of the row of the table
ReadHTMLOutput = ReadHTMLOutput & "</tr>" & vbcrlf
'Go to the next row in the file
Next
'Add the HTML for the end of the table
ReadHTMLOutput = ReadHTMLOutput & "</table>" & vbcrlf
'Fill the DIV with the contents of the variable
OutputTable.InnerHTML = ReadHTMLOutput
End Function
and in the HTML:
<div id="OutputTable"></div>
That way, the DIV is filled with the HTML from ReadHTMLOutput
The issue is this line.. The first argument of OpenTextFile takes a string, but you have passed it an Object. You've already opened the text file for writing using CreateTextFile.
Set WriteOutput = fso.OpenTextFile(OutputHTML, 8, True)
Get rid of this line and change all remaining instances of WriteOutput to OutputHTML.
I am sending an e-mail from Excel using Outlook. I am sending the message as an html message. The message sends but not in the format I expect. The headers are fine but the cells below do not left align as I expect.
How do I get the cells below the header to be left aligned? I thought by using the align attribute it should be fine?
My code
Private Function CreateHTMLMsg() As String
Dim msg As String
Dim colourMkt As String
Dim colourBid As String
Dim colourAsk As String
Dim i As Integer
msg = "<table style='font-size: 12pt;'><tr></tr><tr><th align='left'>Fund</th><th> </th>" & _
"<th align='left'>Mkt Spread</th><th> </th>" & _
"<th align='left'>Bid Spread</th><th> </th>" & _
"<th align='left'>Ask Spread</th><th> </th></tr>"
For i = 1 To UBound(pBreaches)
If pBreaches(i).SendEmail = True Then
If pBreaches(i).BreachedMkt = True Then
colourMkt = "yellow"
Else
colourMkt = "transparent"
End If
If pBreaches(i).BreachedBid = True Then
colourBid = "yellow"
Else
colourBid = "transparent"
End If
If pBreaches(i).BreachedAsk = True Then
colourAsk = "yellow"
Else
colourAsk = "transparent"
End If
msg = msg & "<tr style='font-size: 10pt;'><td>" & pBreaches(i).Fund & "</td><td> </td><td>" & _
"<td align='left' style='background-color:" & colourMkt & "'>" & pBreaches(i).SpreadMkt & "</td><td> </td><td>" & _
"<td align='left' style='background-color:" & colourBid & "'>" & pBreaches(i).SpreadBid & "</td><td> </td><td>" & _
"<td align='left' style='background-color:" & colourAsk & "'>" & pBreaches(i).SpreadAsk & "</td><td> </td><td></tr>"
End If
Next i
CreateHTMLMsg = msg & "</table>"
End Function
Try with :
style="float: left;" (HTML)
float: left; (CSS)
Here is more infos about HTML table and CSS about it : Complete Guide to the Table element
I've been trying my hand at some code that is supposed to convert a range in a worksheet to an html table. It seems to work fine mostly. But sometimes populates the rows multiple times, meaning there would be only 2 rows to copy in the active sheet, but the html table output contains repetitions of the header and data rows in the table rows of the html code. The funny thing is if I set a break point just after counting rows and columns the bug seems to occur less often. I'm really lost here could anybody shed some light on this?
I am using the following code:
' establish number of columns and rows to send
Report.Activate 'this is a worksheet object
NumbofRows = Report.Range("A1", Range("A1").End(xlDown)).Rows.Count
NumbofCols = Report.Range("A1", Range("A1").End(xlToRight)).Columns.Count
' Populate headers
TableHeaders = "<table> <tr>"
For i = 1 To NumbofCols
TableHeaders = TableHeaders & "<th>" & Report.Cells(1, i) & "</th>"
Next i
TableHeaders = TableHeaders & "</tr>"
' populate response rows
For y = 2 To NumbofRows
If WorksheetFunction.IsEven(y) Then
Style = "style= " & Chr(39) & "background:#CCEBFF" & Chr(39)
Else
Style = "style= " & Chr(39) & "background:#E6F5FF" & Chr(39)
End If
' loop through cells on the current row and add them to the table
TableRows = TableRows & "<tr " & Style & ">"
For x = 1 To NumbofCols
TableRows = TableRows & "<td>" & Report.Cells(y, x) & "</td>"
Next x
TableRows = TableRows & "</tr>"
Next y
' close table tag
TableRows = TableRows & "</table> <br> <br>"
'stick them together
ResponseTable = TableHeaders & TableRows
A common error when relying upon ActiveSheet is to specify a cell range's parent while failing to specify the same parent on the cells that mark the start and stop of the range. Example:
NumbofRows = Report.Range("A1", Report.Range("A1").End(xlDown)).Rows.Count
NumbofCols = Report.Range("A1", Report.Range("A1").End(xlToRight)).Columns.Count
I would wrap this whole segment of code into a With ... End With code block and prefix each cell/range definition with a .. The . specifies that each reference belongs to the parent defined with the With ... End With code.
With Report
' establish number of columns and rows to send
'.Activate 'NOT NECESSARY
NumbofRows = .Range("A1", .Range("A1").End(xlDown)).Rows.Count
NumbofCols = .Range("A1", .Range("A1").End(xlToRight)).Columns.Count
' Populate headers
TableHeaders = "<table> <tr>"
For i = 1 To NumbofCols
TableHeaders = TableHeaders & "<th>" & .Cells(1, i) & "</th>"
Next i
TableHeaders = TableHeaders & "</tr>"
' populate response rows
For y = 2 To NumbofRows
If CBool(y Mod 2) Then
Style = "style= " & Chr(39) & "background:#E6F5FF" & Chr(39)
Else
Style = "style= " & Chr(39) & "background:#CCEBFF" & Chr(39)
End If
' loop through cells on the current row and add them to the table
TableRows = TableRows & "<tr " & Style & ">"
For x = 1 To NumbofCols
TableRows = TableRows & "<td>" & .Cells(y, x) & "</td>"
Next x
TableRows = TableRows & "</tr>"
Next y
' close table tag
TableRows = TableRows & "</table> <br/> <br/>"
'stick them together
ResponseTable = TableHeaders & TableRows
End With
That should take care of errant behavior and free you from relying upon ActiveSheet for the parentage of cell/range references.
Your use of Report.Range("A1").End(xlDown) to define the extent of a range is a bit troublesome. With no rows in the table beyond a header row, you are defining all rows to the bottom of the worksheet.