HTML table borders not displaying in GMAIL (only)

john316swan

Board Regular
Joined
Oct 13, 2016
Messages
66
Office Version
  1. 2019
Platform
  1. Windows
Hi Excel Guru's,

I am having trouble with html borders when the email is read via gMail (Outlook/Apple Mail Client both read it). I googled and there wasn't much info, other than someone suggesting I change the .BodyFormat = 2 (or 'olFormatHTML)...which didn't work :( Please help me figure this out, it's driving me crazy :mad:

Sub emailCoaches()
'This will send a weekly email to coaches letting them know which students are on hold for their scholarship offer
Dim ws As Worksheet
Dim sportLr As Double, recruitsLr As Double
Dim x As Double, y As Double
Dim sport As String, studentHold As String, holdList As String
Dim strHeader As String, strbody As String, strFooter As String
Dim SigString As String, signature As String
Dim OL As Outlook.Application
Dim holdEmail As Outlook.MailItem


sportLr = Sheets("Tables").Cells(Rows.Count, 25).End(xlUp).Row
recruitsLr = Sheets("Recruits").Cells(Rows.Count, 1).End(xlUp).Row
SigString = Environ("appdata") & "\Microsoft\Signatures\No Logo.htm"
signature = GetSignature(SigString)


With Application
.EnableEvents = False
.ScreenUpdating = False
End With


'This is the header that won't change for all emails
strHeader = "******>Dear Coach,<br><br>" _
& "Below is a list of all students for whom we can send a financial aid package to, " _
& "but do not have an athletic offer:<br><br>"
'This is the footer that won't change for all emails
strFooter = "<br>The data and amounts in the above table are <b>ESTIMATES</b> based on the most recent information we have. " _
& "If an art scholarship is <b>POSSIBLE</b> you can confirm with the student whether they plan on actually " _
& "auditioning. Please let me or Cathy know if anything looks funky or you have any questions.</BODY></html>" & signature


'This code creates a loop that goes through each of the hold reasons
For x = 2 To sportLr
nextSport:
'Sheets("Tables").Activate
sport = Sheets("Tables").Cells(x, 25)
Sheets("Recruits").Activate
'Now we're going to loop through all students and create a table of holds that meet the "X" criteria
For y = 2 To recruitsLr
If Cells(y, 16) = sport Then
studentHold = "<tr><td nowrap>" & Cells(y, 1) & "</td><td nowrap>" & Cells(y, 2) & "</td><td nowrap>" & Cells(y, 3) & "</td><td nowrap>" & Cells(y, 9) _
& "</td><td>" & Cells(y, 18) & "</td><td>" & Format(Cells(y, 21), "#,###") & "</td><td nowrap>" & Format(Cells(y, 22), "#,###") & "</td><td nowrap>" & Format(Cells(y, 23), "#,###") _
& "</td><td nowrap>" & Format(Cells(y, 24), "#,###") & "</td><td nowrap>" & Format(Cells(y, 25), "#,###") & "</td><td nowrap>" & Cells(y, 30) _
& "</td><td nowrap>" & Format(Cells(y, 26), "#,###") & "</td><td nowrap>" & Format(Cells(y, 27), "#,###") & "</td><td nowrap>" & Format(Cells(y, 28), "#,###") & "</td>"
holdList = holdList & studentHold & "</tr>"
End If
Next y
'Once you loop through list, if there are no holds, we will then skip to next sport
If holdList = "" Then
If x > sportLr Then
Exit Sub
End If
x = x + 1
holdlst = ""
GoTo nextSport
End If
'Now we will send the email to the coach
Set OL = CreateObject("Outlook.Application")
Set holdEmail = OL.CreateItem(0)

strbody = "<style>table, th, td {border: 1px solid black; border-collapse: collapse; word-wrap: break-word; text-align: center; padding: 5px;}</style>" _
& "<table><tr><th no wrap>Student ID</th><th nowrap>Last</th><th nowrap>First</th><th nowrap>FAFSA</th><th nowrap>Room & Board" _
& "</th><th nowrap>Academic</th><th nowrap>Scholar Event</th><th nowrap>Pell</th><th nowrap>Cal Grant" _
& "</th><th nowrap>Tot. Free Money</th><th nowrap>Arts Possible</th><th nowrap>Est. Loans</th><th nowrap>Est Costs" _
& "</th><th nowrap>Est Bal B4 Ath $</th></tr>" & holdList & "</table>"

With holdEmail
.To = Sheets("Tables").Cells(x, 27)
.Subject = "19-20 Financial Aid Package Holds for " & Sheets("Tables").Cells(x, 26)
.HTMLBody = strHeader & strbody & strFooter
.BodyFormat = 2
.Send
End With
'Now we reset hold list and move to next sport
Set OL = Nothing
Set holdEmail = Nothing
holdList = ""
Next x


With Application
.EnableEvents = True
.ScreenUpdating = True
End With


End Sub
Function GetSignature(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetSignature = ts.ReadAll
ts.Close
End Function


<style>table, th, td {border: 1px solid black; border-collapse: collapse; word-wrap: break-word; text-align: center; padding: 5px;}</style>
 
Last edited:

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
OR is there a way to copy the HTML table I created to a temporary workbook with borders and then email it?
 
Upvote 0
Are you applying any formatting/styles to the HTML you are creating?
 
Upvote 0
Yes, but it's hard to show because the posting keeps converting it to HTML...is there a way to post the vba in a way that won't convert it to HTML like it did above? Code is posted at https://codeshare.io/5Z0y4o Hopefully I am not violating any rules by posting link to external code, if so I can delete it right away. Sorry in advance!<style>table, th, td {border: 1px solid black; border-collapse: collapse; word-wrap: break-word; text-align: center; padding: 5px;}</style>
 
Last edited:
Upvote 0
Ok, I think I figured out how to show the HTML code :)

Code:
Sub emailCoaches()
'This will send a weekly email to coaches letting them know which students are on hold for their scholarship offer
Dim ws As Worksheet
Dim sportLr As Double, recruitsLr As Double
Dim x As Double, y As Double
Dim sport As String, studentHold As String, holdList As String
Dim strHeader As String, strbody As String, strFooter As String
Dim SigString As String, signature As String
Dim OL As Outlook.Application
Dim holdEmail As Outlook.MailItem


If [UpdateWbk] = True And Weekday(Now(), vbTuesday = 1) Then


    sportLr = Sheets("Tables").Cells(Rows.Count, 25).End(xlUp).Row
    recruitsLr = Sheets("Recruits").Cells(Rows.Count, 1).End(xlUp).Row
    SigString = Environ("appdata") & "\Microsoft\Signatures\No Logo.htm"
    signature = GetSignature(SigString)
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    'This is the header that won't change for all emails
    strHeader = [HTML]"******>Dear Coach,<br><br>" _                & "Below is a list of all students for whom we can send a financial aid package to, " _                & "but do not have an athletic offer:<br><br>"    'This is the footer that won't change for all emails    strFooter = "<br>The data and amounts in the above table are <b>ESTIMATES</b> based on the most recent information we have. " _                & "If an art scholarship is <b>POSSIBLE</b> you can confirm with the student whether they plan on actually " _                & "auditioning - <b>HOWEVER</b> even with a ""False"" they may still apply although they did not indicate they were interested on their application. " _                & " If an amount is blank for Cal Grant, it means we have not yet been able to verify their eligibility. " _                & "Please let me or Cathy know if anything looks funky or you have any questions.</BODY></html>"[/HTML] & signature
    
    'This code creates a loop that goes through each of the hold reasons
    For x = 2 To sportLr
nextSport:
        'Sheets("Tables").Activate
        sport = Sheets("Tables").Cells(x, 25)
        Sheets("Recruits").Activate
        'Now we're going to loop through all students and create a table of holds that meet the "X" criteria
        For y = 2 To recruitsLr
            If Cells(y, 16) = sport Then
<div>                studentHold = [HTML]"<tr><td nowrap>" & Cells(y, 1) & "</td><td nowrap>" & Cells(y, 2) & "</td><td nowrap>" & Cells(y, 3) & "</td><td nowrap>" & Cells(y, 9) _                & "</td><td>" & Cells(y, 18) & "</td><td>" & Format(Cells(y, 21), "#,###") & "</td><td nowrap>" & Format(Cells(y, 22), "#,###") & "</td><td nowrap>" & Format(Cells(y, 23), "#,###") _                & "</td><td nowrap>" & Format(Cells(y, 24), "#,###") & "</td><td nowrap>" & Format(Cells(y, 25), "#,###") & "</td><td nowrap>" & Cells(y, 30) _                & "</td><td nowrap>" & Format(Cells(y, 26), "#,###") & "</td><td nowrap>" & Format(Cells(y, 27), "#,###") & "</td><td nowrap>" & Format(Cells(y, 28), "#,###") & "</td>"                holdList = holdList & studentHold & "</tr>"[/HTML]            End If
        Next y
        'Once you loop through list, if there are no holds, we will then skip to next sport
        If holdList = "" Then
            If x > sportLr Then
                Exit Sub
            End If
            x = x + 1
            holdlst = ""
            GoTo nextSport
        End If
        'Now we will send the email to the coach
        Set OL = CreateObject("Outlook.Application")
        Set holdEmail = OL.CreateItem(0)
    
<div>        [HTML]strbody = "<style>table, th, td {border: 1px solid black; border-collapse: collapse; word-wrap: break-word; text-align: center; padding: 5px;}</style>" _                  & "<table><tr><th no wrap>Student ID</th><th nowrap>Last</th><th nowrap>First</th><th nowrap>FAFSA</th><th nowrap>Room & Board" _                  & "</th><th nowrap>Academic</th><th nowrap>Scholar Event</th><th nowrap>Pell</th><th nowrap>Cal Grant" _                  & "</th><th nowrap>Tot. Free Money</th><th nowrap>Arts Possible</th><th nowrap>Est. Loans</th><th nowrap>Est Costs" _                  & "</th><th nowrap>Est Bal B4 Ath $</th></tr>" & holdList & "</table>"[/HTML]    
        With holdEmail
            .To = Sheets("Tables").Cells(x, 27)
            .Subject = "AUTOMATED 19-20 Financial Aid Package Holds for " & Sheets("Tables").Cells(x, 26)
            .HTMLBody = strHeader & strbody & strFooter
            .BodyFormat = 2
            .Send
        End With
        'Now we reset hold list and move to next sport
        Set OL = Nothing
        Set holdEmail = Nothing
        holdList = ""
    Next x
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With


End If


End Sub

Function GetSignature(ByVal sFile As String) As String
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetSignature = ts.ReadAll
    ts.Close
End Function
<style>table, th, td {border: 1px solid black; border-collapse: collapse; word-wrap: break-word; text-align: center; padding: 5px;}</style><style>table, th, td {border: 1px solid black; border-collapse: collapse; word-wrap: break-word; text-align: center; padding: 5px;}</style>
 
Upvote 0
Try wrapping the whole thing in HTML Code tags.
 
Upvote 0
Hi,

see if the following works for you.
I have put a space in all the tags so they display here and I did not check 'studentHold' but the table header appears in my Gmail without issue.
The style is added to the head, where it would be in an html page and all the nowrap removed as I added it to the style.

Code:
PgeStart = "< html >< head >"
PgeEnd = "< /html >"
PgeStyle = "<style>table, th, td {border: 1px solid black; border-collapse: collapse; word-wrap: break-word; text-align: center; padding: 5px; white-space:no wrap;}< /style >< /head >" _



StrHeader = "******>Dear Coach,<br><br>" _
 & "Below is a list of all students for whom we can send a financial aid package to, " _
 & "but do not have an athletic offer:<br><br>"


 strFooter = "<br>The data and amounts in the above table are <b>ESTIMATES</b> based on the most recent information we have. " _
 & "If an art scholarship is <b>POSSIBLE</b> you can confirm with the student whether they plan on actually " _
 & "auditioning. Please let me or Cathy know if anything looks funky or you have any questions.</body></html>" & Signature



 studentHold = "<tr>< td >" & Cells(y, 1) & "< /td >< td >" & Cells(y, 2) & "< /td >< td >" & Cells(y, 3) & "< /td >< td >" & Cells(y, 9) _
 & "< /td >< td >" & Cells(y, 18) & "< /td >< td >" & Format(Cells(y, 21), "#,###") & "< /td >< td >" & Format(Cells(y, 22), "#,###") & "< /td >< td >" & Format(Cells(y, 23), "#,###") _
 & "< /td >< td >" & Format(Cells(y, 24), "#,###") & "< /td >< td >" & Format(Cells(y, 25), "#,###") & "< /td >< td >" & Cells(y, 30) _
 & "< /td >< td >" & Format(Cells(y, 26), "#,###") & "< /td >< td >" & Format(Cells(y, 27), "#,###") & "< /td >< td >" & Format(Cells(y, 28), "#,###") & "< /td >" _
 & holdList = holdList & studentHold & "</tr>"


StrBody = "<table><tr>< th >Student ID< /th >< th >Last< /th >< th >First< /th >< th >FAFSA< /th >< th >Room & Board" _
 & "< /th >< th >Academic< /th ><th nowrap>Scholar Event< /th ><th nowrap>Pell< /th >< th >Cal Grant" _
 & "< /th >< th >Tot. Free Money< /th >< th >Arts Possible< /th >< th >Est. Loans< /th >< th >Est Costs" _
 & "< /th >< th >Est Bal B4 Ath $< /th ></tr>" & holdList & "</table>"



StrMessage = PgeStart & PgeStyle & StrHeader & StrBody & strFooter


'HTMLBody[COLOR="#FF0000"]=strMessage[/COLOR]
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,649
Messages
6,120,728
Members
448,987
Latest member
marion_davis

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top