Create HTML table in Outlook mail with specific style color and border using VBA

Question

I am trying to create a table in the .HTMLBody of Outlook mail.

The table is created with correct headings and data rows, but not the style.
I need every other row with different color.
Also the header text and background color need to be changed.

    Dim EmailApp As Outlook.Application
    Dim EmailItem As Outlook.MailItem
    Set EmailApp = New Outlook.Application

    For Each cCel In eSh.Range("A2:A" & eSh.Cells(eSh.Rows.Count, "A").End(xlUp).Row)
    
        ' Clearing values
        cCel.Offset(0, 2) = ""
    
        If IsEmpty(cCel.Offset(0, 1)) Then GoTo NX
       
        mSend = False
        EmailBody = ""
        
        ' Salutation
        ' this is the possible line to be changed in order to get the particular style ???
        EmailBody = "<style> th , td { border: 1px solid #e3e3e3; padding: 4px 8px; text-align: left; } tr:nth-child(odd) td { background-color: #e7edf0; }</style>Ola, " & _
          cCel & "<br><br>" & _
          "<table><tr><th>Numero do Contratro</th><th>Contratante</th><th>Saldo de Contrato</th></tr>"
                
        ' Filter
        DB.Range("1:1").AutoFilter Field:=gestI.Column, Criteria1:=cCel
            
        If DB.Range("A" & DB.Rows.Count).End(xlUp).Row = 1 Then GoTo NX
            
        For Each mCel In DB.Range("AG2", DB.Range("AG" & DB.Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
                
            If mCel.Row = 1 Then GoTo NXX
            If Not IsDate(mCel) Then GoTo NXX
                
            'mCel.Select
            exDate = DateSerial(Year(mCel) + 1, Month(mCel), Day(mCel))
            
            If DateDiff("d", Date, exDate) < 0 Then
                mSend = True
                
                EmailBody = EmailBody & "<tr>" & _
                  "<td>" & DB.Cells(mCel.Row, "C").Text & "</td>" & _
                  "<td>" & DB.Cells(mCel.Row, "I").Text & "</td>" & _
                  "<td>" & DB.Cells(mCel.Row, "X").Text & "</td></tr>"
                
            End If
                
NXX:    Next mCel
    
        If mSend = False Then GoTo NX
    
        Set EmailItem = EmailApp.CreateItem(olMailItem)
            
        With EmailItem
            .To = cCel.Offset(0, 1).Text 'Email address from DataBase  
            .Subject = "Información Sobre Contractos"   
            .HTMLBody = EmailBody & "</table><br><br>Atenciosamente"
            .Display
            .Send
            cCel.Offset(0, 2).Value = "Sent" 'mark the mail
            X = X + 1
        End With
    
NX: Next cCel

Answer 1

Why don't you use GetInspector.WordEditor property to paste the formatted table? Several times ago I've written a function to paste table to e-mail

Function SendTable(rng As Range, Email As String, Subja As String)  ', Emltext As String)
    rng.CurrentRegion.Copy
      Dim myInspector As Object
       Dim wdDoc As Object
       Dim myitem As Object
       
       
    Set myitem = CreateObject("Outlook.Application").CreateItem(0)
    Set myInspector = myitem.GetInspector
    Set wdDoc = myInspector.WordEditor
     
    With myitem
    
         .To = Email
         .Subject = Subja
    '     .Body = Emltext
         .Display
        
    End With
    wdDoc.Range.Paragraphs.Add
    wdDoc.Range.Paragraphs.item(1).Range.Text = Emltext& vbCr
    wdDoc.Range.Paragraphs.Add
    wdDoc.Range.Paragraphs.Add
    wdDoc.Range.Paragraphs.item(3).Range.Text = "Hello2" & vbCr
    wdDoc.Range.Paragraphs.Add
    rng.CurrentRegion.Copy
    wdDoc.Range.Paragraphs(2).Range.PasteExcelTable False, True, False'here is pastes the table
    wdDoc.Range.Paragraphs(2).Range.Select
    
    
    End Function

and in code this function looks like

  Sub test()
    Dim OA As Object, oitem As Object
    
    Set OA = CreateObject("Outlook.Application")
    
    Set oitem = OA.CreateItem(0)
    oitem = SendTable(Range(Cells(2, 2), Cells(4, 4)), "xxxxxx@xxxx.ru", "Report "&Now)  
    
    End Sub