Shading HTML Tables (1 Viewer)

[david_johnson_CR]

Greetings,

So I'm still learning to integrate HTML with VBA. I cannot figure out how to shade the table in my vba-generated email. I've seen some tutorials but I cannot successfully merge those lessons with how my code is laid out. Any help would be greatly appreciated. Ideally, the header row, first row, and second row (it will always be only those rows) could each be a separate color.

Thanks in advance!
David

Private Sub Command1_Click()
    Dim olApp As Object
    Dim olItem As Variant
    Dim db As DAO.Database
    Dim rec As DAO.Recordset
    Dim strQry As String
    Dim aHead(1 To 2) As String
    Dim aRow(1 To 2) As String
    Dim aBody() As String
    Dim lCnt As Long
    Dim asPreTable As String
    Dim asPostTable As String
    Dim appsrec As DAO.Recordset
    Dim str_app_SQL As String
    Dim ApplicantID As Integer
    Dim AppEmail As String
    Dim SAEmail As String
    Dim RCEmail As String
    Dim GCEmail As String
    Dim GCName As String
    Dim GCBackupEmail As String
    Dim app_name As String
    Dim recipients As String
    Dim RCName As String
  ' Dim strFrom As String
    Dim mbe_wbe_email As DAO.Database
    Dim GCPhone As String
    Dim altAppEmail As String
    Dim email_log As DAO.Recordset
    Set mbe_wbe_email = CurrentDb
    Dim cohnreznick As String
    
    
    Set email_log = mbe_wbe_email.OpenRecordset("sent_email_log")
    
    
   ' strFrom = "recovery.communications@cohnreznick.com"
    
    
    str_app_SQL = "SELECT * FROM applicant_list"
    Set appsrec = CurrentDb.OpenRecordset(str_app_SQL)
    
    If Not appsrec.BOF And Not appsrec.EOF Then
        appsrec.MoveFirst
        Do While Not appsrec.EOF
    
    AppEmail = DLookup("applicant_prime_contact_email", "applicant_list", "applicant_list_ID = " & appsrec!applicant_list_ID)
    altAppEmail = DLookup("applicant_backup_contact_email", "applicant_list", "applicant_list_ID = " & appsrec!applicant_list_ID)
    app_name = DLookup("applicant_name", "applicant_list", "applicant_list_ID = " & appsrec!applicant_list_ID)
    'SAEmail = DLookup("contact_email", "contacts_table_primary", "applicant_ID = " & appsrec!applicant_list_ID & " AND [contact_role] = 'Section Administrator'")
    RCEmail = DLookup("recov_coord_email", "applicant_list", "applicant_list_ID = " & appsrec!applicant_list_ID)
    RCName = DLookup("recov_coord_name", "applicant_list", "applicant_list_ID = " & appsrec!applicant_list_ID)
    GCEmail = DLookup("grant_coord_email", "applicant_list", "applicant_list_ID = " & appsrec!applicant_list_ID)
    GCName = DLookup("grant_coord_name", "applicant_list", "applicant_list_ID = " & appsrec!applicant_list_ID)
    GCPhone = DLookup("grant_coord_phone", "applicant_list", "applicant_list_ID = " & appsrec!applicant_list_ID)
    GCBackupEmail = DLookup("team_lead_email", "applicant_list", "applicant_list_ID = " & appsrec!applicant_list_ID)
    
    If AppEmail = altAppEmail Then
        recipients = AppEmail
    Else
        recipients = AppEmail & "; " & altAppEmail
    End If
    
    If GCEmail = GCBackupEmail Then
        cohnreznick = GCEmail
    Else
        cohnreznick = GCEmail & "; " & GCBackupEmail
    End If
    
    
   ' MsgBox SAEmail
   'Create the header row
    aHead(1) = "Texas Comptroller of Public Accounts"
    aHead(2) = "Link"
  
    asPreTable = "Greetings, <br><br>" _
               & "As you've likely heard from your FEMA Program Delivery Manager or TDEM counterpart, federal procurement standards require Public Assistance subrecipients take affirmative steps towards socioeconomic contracting.<br><br>" _
               & "Getting this message out to all Harvey subrecipients is critical because failing to take and document these efforts fall under FEMA's Top 10 Procurement Mistakes</a> leading to the potential loss of Public Assistance funding. Likewise, it is frequently identified as a justification to de-obligate funding by the Department of Homeland Security (DHS), Office of Inspector General (OIG).<br><br>" _
               & "In this email, we want to highlight the specific procurement considerations found in concerning <b>contracting with small businesses, women's business enterprises, minority-owned businesses, and labor surplus area firms.</b><br><br>" _
               & "To be clear, this requirement is not a set-aside and your entity is not required to award to these types of firms based solely on their status as socioeconomic contractors.  Rather, 2 CFR 200 requires that subrecipients follow the following six affirmative steps:<br><br>" _
               & "<blockquote><i>1.  <b>Solicitation Lists. </b>Must place small and minority businesses and women's business enterprises on solicitation lists. 2 C.F.R. § 200.321(b)(1).</i></blockquote><br>" _
               & "<blockquote><i>2.  <b>Solicitations. </b>Must assure that it solicits small and minority businesses and women's business enterprises whenever they are potential sources. 2 C.F.R. § 200.321(b)(2). </i></blockquote><br>" _
               & "<blockquote><i>3.  <b>Dividing Requirements. </b>Must divide total requirements, when economically feasible, into smaller tasks or quantities to permit maximum participation by small and minority businesses and women's business enterprises. 2 C.F.R. § 200.321(b)(3). </i></blockquote><br>" _
               & "<blockquote><i>4.  <b>Delivery Schedules. </b>Must establish delivery schedules, where the requirement permits, which encourage participation by small and minority businesses and women's business enterprises. 2 C.F.R. § 200.321(b)(4). </i></blockquote><br>" _
               & "<blockquote><i>5.  <b>Obtaining Assistance. </b>Must use the services and assistance, as appropriate, of such organizations as the Small Business Administration and the Minority Business Development Agency of the Department of Commerce. 2 C.F.R. § 200.321(b)(5).</i></blockquote><br>" _
               & "<blockquote><i>6.  <b>Prime Contractor Requirements. </b>Must require the prime contractor, if subcontracts are anticipated or let, to take the five affirmative steps described in steps 1-5 above. 2 C.F.R. § 200.321(b)(6). </i></blockquote><br>" _
               & "In the table below, we've provided links to two resources that you might find useful. First, is the Texas Comptroller's centralized list of Historically Underutilized Business (HUB) vendors.  Searching this tool for HUB vendors can be useful in satisfying the requirements of Affirmative Steps 1, 2, & 3. For your convenience, we've exported a list of over 19,000 underutilized businesses across a wide array of business categories; the list can be found in the attachments of this message.<br><br>" _
               & "The second link provides a contact list of 'HUB Coordinators', or more simply put, a list of entities which have expressed their willingness to accept notices of subcontracting opportunities from vendors to distribute to their minority and woman-owned business members. Again, this may be a useful resource for you and a way to demonstrate your affirmative steps towards Assuring that small and minority businesses, and women's business enterprises are solicited whenever they are potential sources. <br><br>" _

    asPostTable = "<br>To be clear, some firms are recognized as HUB vendors by other states.  From a federal perspective, soliciting these firms will also count towards satisfying the federal requirements of  <br><br>" _
                & "Procurement under federal grant programs can be challenging. We're here to assist with questions or concerns you may encounter along the way.  Feel free to reach out to your Grant Coordinator at " & GCEmail & " or TDEM Recovery Coordinator at " & RCEmail & " and let us know how we might be of assistance. <br><br> " _
                & "Sincerely,<br>" _
                & GCName & "" _
                & "<br><br><b>" & GCName & "</b><br>" _
                & "Government and Public Sector<br>" _
                & "CohnReznick Advisory<br>" _
                & "Tel: " & GCPhone & "" _
                & "<br>Fax: 512-494-9101" _
                & "<br><u><font color=""blue"">" & GCEmail & "</u></font>" _
                

    lCnt = 1
    ReDim aBody(1 To lCnt)
    aBody(lCnt) = "<HTML><body>" & asPreTable & "<table border='2'><tr><th>" & Join(aHead, "</th><th>") & "</th></tr>"
    

    'Create each body row
    strQry = "SELECT * From contacts_table_primary"  'WHERE applicant_ID = " & appsrec!applicant_list_ID
    Set db = CurrentDb
    Set rec = CurrentDb.OpenRecordset(strQry)

    If Not (rec.BOF And rec.EOF) Then
        Do While Not rec.EOF
            lCnt = lCnt + 1
            ReDim Preserve aBody(1 To lCnt)
            aRow(1) = rec("List")
            aRow(2) = rec("Link")
            aBody(lCnt) = "<tr><td>" & Join(aRow, "</td><td>") & "</td></tr>"
            rec.MoveNext
        Loop
    End If

    aBody(lCnt) = aBody(lCnt) & "</table>" & asPostTable & "</body></html>"

    
    'create the email
    Set olApp = CreateObject("Outlook.application")
    Set olItem = olApp.CreateItem(0)
   'olItem.from = strFrom
       
    
    olItem.ReplyRecipients.Add GCEmail
   ' olItem.display
    olItem.To = recipients
    olItem.Subject = "DR-4332 | " & app_name & " | HUB Procurement Guidance"
    olItem.CC = RCEmail & "; " & cohnreznick
    olItem.bcc = "communications@crmail.getadvantage.com"
    olItem.htmlbody = Join(aBody, vbNewLine)
  ' olItem.sentonbehalfofname = """Recovery Communications"" <Recovery.Communications@CohnReznick.com>"
    olItem.OriginatorDeliveryReportRequested = True
    olItem.SentOnBehalfOfName = "recovery.communications@cohnreznick.com"
    Dim docname1 As String
    
    docname1 = "H:\pmo_processes\recovery_communications\2018-01-26_MBE_WBE_Blast\attachment\Texas CMBL-HUB Vendor List (2017-12-13).xlsx"
    
    
    Dim MyAttachments As Variant
    Set MyAttachments = olItem.attachments
    MyAttachments.Add docname1
    
    olItem.Save


  
    appsrec.MoveNext
    Loop
    
    End If
    appsrec.Close
    Set appsrec = Nothing
    
    
End Sub

 

[static]

To apply style to a tag you either add a style section in the header or apply it directly in the tag.

<div style='font-family:arial;color:blue;background-color: orange;'>Hi I'm blue text on an orange background</div>

 

[arnelgp]

change this portion:

lCnt = 1
    ReDim aBody(1 To lCnt)
    aBody(lCnt) = "<HTML><body>" & asPreTable & "<table border='2'><tr><th>" & Join(aHead, "</th><th>") & "</th></tr>"
    

    'Create each body row
    strQry = "SELECT * From contacts_table_primary"  'WHERE applicant_ID = " & appsrec!applicant_list_ID
    Set db = CurrentDb
    Set rec = CurrentDb.OpenRecordset(strQry)

    If Not (rec.BOF And rec.EOF) Then
        Do While Not rec.EOF
            lCnt = lCnt + 1
            ReDim Preserve aBody(1 To lCnt)
            aRow(1) = rec("List")
            aRow(2) = rec("Link")
            aBody(lCnt) = "<tr><td>" & Join(aRow, "</td><td>") & "</td></tr>"
            rec.MoveNext
        Loop
    End If

to this:

lCnt = 1
    ReDim aBody(1 To lCnt)
    aBody(lCnt) = "<HTML><body>" & asPreTable & "<table border='2' width='100%'>" & _
	"<style type=""text/css"">" & _
         "th {color:#FFFFFF; padding: 10px 10px 10px 10px; background-color:#129EE1}" & _
         "td.data01 {vertical-align:top; align:left; padding: 5px 5px 5px 5px; background-color:#CC9999}" & _
         "td.data02 {vertical-align:top; align:left; padding: 5px 5px 5px 5px; background-color:#9999CC}" & _
         "</style>" & _
	 "<th>" & Join(aHead, "</th><th>") & "</th>"
 
    'Create each body row
    strQry = "SELECT * From contacts_table_primary"  'WHERE applicant_ID = " & appsrec!applicant_list_ID
    Set db = CurrentDb
    Set rec = CurrentDb.OpenRecordset(strQry)

    Dim strTdClass As String

    If Not (rec.BOF And rec.EOF) Then
        Do While Not rec.EOF
            lCnt = lCnt + 1
            ReDim Preserve aBody(1 To lCnt)
            aRow(1) = rec("List")
            aRow(2) = rec("Link")
            If lCnt Mod 2 <> 0 Then
                strIDClass = "<tr><td class=""data01"">"
            Else
                strIDClass = "<tr><td class=""data02"">"
            End If
            aBody(lCnt) = strIDClass & Join(aRow, "</td><td>") & "</td></tr>"
            rec.MoveNext
        Loop
    End If