Formatting two data tables in Outlook mail

Question

I am trying to put two data tables into an email.

I have VBA code to include one table. The data for the second table is in tEmailData, which relates to the tDistinct_DCMs table as well on the DCM_Email field.

I've provided my current VBA for the email, and the VBA format for the second table.

How can I add that table after the first table and a short paragraph of text?

Option Compare Database
Option Explicit

Public Sub DCMEmailReviewVBA()

    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

    Set rst2 = CurrentDb.OpenRecordset("select distinct DCM_email from tDistinct_DCMs")
    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=" & Chr(34) & "Calibri" & Chr(34) & "><b>" & _
                        "<tr bgcolor=lightBlue>" & _
                            "<TD align = 'left'>Status</TD>" & _
                            "<TD align = 'left'>First Name</TD>" & _
                            "<TD align = 'left'>Last Name</TD>" & _
                            "<TD align = 'left'>UIN</TD>" & _
                            "</tr></b></font>"
    strFntNormal = "<font color=black face=" & Chr(34) & "Calibri" & Chr(34) & " size=3>"
    strFntEnd = "</font>"

    Set rst = CurrentDb.OpenRecordset("SELECT * FROM tFinalDCM_EmailList where DCM_Email='" & rst2!DCM_Email & "' Order by [Cardholder_UIN] asc")
    rst.MoveFirst



    'Build HTML Output for the DataSet
    strTableBody = strTableBeg & strFntNormal & strTableHeader



    Do Until rst.EOF
        strTableBody = strTableBody & _
                        "<tr>" & _
                            "<TD align = 'left'>" & rst![Action] & "</TD>" & _
                            "<TD align = 'left'>" & rst![Cardholder First Name] & "</TD>" & _
                            "<TD align = 'left'>" & rst![Cardholder Last Name] & "</TD>" & _
                            "<TD align = 'left'>" & rst![Cardholder_UIN] & "</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 CaptureDCMBodyText

    With objMail
        'Set body format to HTML
        .To = rst2!DCM_Email
        .BCC = gDCMEmailBCC
        .Subject = gDCMEmailSubject
        .BodyFormat = olFormatHTML

        .HTMLBody = .HTMLBody & gDCMBodyText

        .HTMLBody = .HTMLBody & "<HTML><BODY>" & strFntNormal & strTableBody & " </BODY></HTML>"

        .HTMLBody = .HTMLBody & gDCMBodySig

        .SentOnBehalfOfName = "..."
        .Display
        '.Send
    End With

    rst2.MoveNext

'Loop

Clean_Up:
    rst.Close
    rst2.Close

    Set rst = Nothing
    Set rst2 = Nothing
    'Set dbs = Nothing


End Sub

Function td(strIn As String) As String
    td = "<TD nowrap>" & strIn & "</TD>"
End Function

VBA for desired second table:

strTableBeg = "<table border=1 cellpadding=3 cellspacing=0>"
    strTableEnd = "</table>"
    strTableHeader = "<font size=3 face=" & Chr(34) & "Calibri" & Chr(34) & "><b>" & _
                        "<tr bgcolor=lightblue>" & _
                            "<TD align = 'left'>Card Type</TD>" & _
                            "<TD align = 'left'>Cardholder</TD>" & _
                            "<TD align = 'left'>ER or Doc No</TD>" & _
                            "<TD align = 'center'>Trans Date</TD>" & _
                            "<TD align = 'left'>Vendor</TD>" & _
                            "<TD align = 'right'>Trans Amt</TD>" & _
                            "<TD align = 'left'>TEM Activity Name or P-Card Log No</TD>" & _
                            "<TD align = 'left'>Status</TD>" & _
                            "<TD align = 'right'>Aging</TD>" & _
                           "</tr></b></font>"

    strFntNormal = "<font color=black face=" & Chr(34) & "Calibri" & Chr(34) & " size=3>"
    strFntEnd = "</font>"

    Set rst = CurrentDb.OpenRecordset("SELECT * FROM tEmailData where DCM_email='" & rst2!DCM_Email & "' Order by Cardholder, Card_Type asc")
    rst.MoveFirst



    'Build HTML Output for the DataSet
    strTableBody = strTableBeg & strFntNormal & strTableHeader



    Do Until rst.EOF
        strTableBody = strTableBody & _
                        "<tr>" & _
                            "<TD align = 'left'>" & rst!Card_Type & "</TD>" & _
                            "<TD align = 'left'>" & rst!Cardholder & "</TD>" & _
                            "<TD align = 'left'>" & rst!ERNumber_DocNumber & "</TD>" & _
                            "<TD align = 'center'>" & rst!Trans_Date & "</TD>" & _
                            "<TD align = 'left'>" & rst!Vendor & "</TD>" & _
                            "<TD align = 'right'>" & Format(rst!Trans_Amt, "currency") & "</TD>" & _
                            "<TD align = 'left'>" & rst!ACTIVITY_Log_No & "</TD>" & _
                            "<TD align = 'left'>" & rst!Status & "</TD>" & _
                            "<TD align = 'right'>" & rst!Aging & "</TD>" & _
                        "</tr>"

        rst.MoveNext
    Loop

Concatenate string variables. Exactly what is the issue you are having? The second table code is not a complete procedure. Where is this code and how do you call it? — June7, Feb 28 '18 at 20:52

Tony Dallimore · Answer 1 · 2018-03-01T16:44:43.280

I have not looked at your tables yet, but the code to build the Html document is faulty.

.HTMLBody = .HTMLBody & gDCMBodyText

.HTMLBody = .HTMLBody & "<HTML><BODY>" & strFntNormal & strTableBody & " </BODY></HTML>"

.HTMLBody = .HTMLBody & gDCMBodySig

I cannot find gDCMBodyText and no previous statement has placed anything in HtmlBody so why are you concatenating to it?

<HTML> must come first and </HTML> must come last.

You mention in your question you want to include text but I am unclear where.

I suggest something like the following:

Dim Table1 As string    ' First table: <table> ... </table>
Dim Table2 As string    ' Second table: <table> ... </table>
Dim TextPre As string   ' Text to come before first table
Dim TextMid As string   ' Text to come between tables
Dim TextPost As string  ' Text to come after second table

Assign appropriate values to the above strings then

.HtmlBody = "<html><body>" & vbLf & _
            TextPre & vbLf & _
            Table1 & vbLf & _
            TextMid & vbLf & _
            TextPost & vbLf & _ 
            "</body></html>"

Part 2

I would treat this as four different problems: (1) format table 1 correctly, (2) format table 2 correctly, (3) combine tables correctly and (4) create HtmlBody.

For problems such as 1, 2 and 3, I use the routines below. Macro HtmlDoc combines a Head and Body element into a simple Html document. This is no big deal but it does make life a little simpler. Macro PutTextFileUtf8 outputs a string as a UTF-8 file. Note 1: UTF-8 is the default coding for Html files and allows any Unicode character within a file. Note 2: This macro requires a reference to "Microsoft ActiveX Data Objects n.n Library".

I would use these routines to (1) check Table 1 was being created correctly, (2) check Table 2 was being created correctly and (3) check the tables are being combined correctly. If any of the files are not as I wish, I can look at the text file. Looking at the Html body of a mis-formatted email is more difficult.

Function HtmlDoc(ByVal Head As String, ByVal Body As String)

  ' Returns a simple Hhml document created from Head and Body

  HtmlDoc = "<!DOCTYPE html>" & vbLf & "<html>" & vbLf
  If Head <> "" Then
    HtmlDoc = HtmlDoc & "<head>" & vbLf & Head & vbLf & "</head>" & vbLf
  End If
  HtmlDoc = HtmlDoc & "<body>" & vbLf & Body & vbLf & "</body>" & vbLf
  HtmlDoc = HtmlDoc & "</html>"

End Function
Public Sub PutTextFileUtf8(ByVal PathFileName As String, ByVal FileBody As String)

  ' Outputs FileBody as a text file (UTF-8 encoding without leading BOM)
  ' named PathFileName

  ' Needs reference to "Microsoft ActiveX Data Objects n.n Library"
  ' Addition to original code says version 2.5. Tested with version 6.1.

  '  1Nov16  Copied from http://stackoverflow.com/a/4461250/973283
  '          but replaced literals with parameters.
  ' 15Aug17  Discovered routine was adding an LF to the end of the file.
  '          Added code to discard that LF.

  ' References: http://stackoverflow.com/a/4461250/973283
  '             https://www.w3schools.com/asp/ado_ref_stream.asp

  Dim BinaryStream As Object
  Dim UTFStream As Object

  Set UTFStream = CreateObject("adodb.stream")

  UTFStream.Type = adTypeText
  UTFStream.Mode = adModeReadWrite
  UTFStream.Charset = "UTF-8"
  ' The LineSeparator will be added to the end of FileBody. It is possible
  ' to select a different value for LineSeparator but I can find nothing to
  ' suggest it is possible to not add anything to the end of FileBody
  UTFStream.LineSeparator = adLF
  UTFStream.Open
  UTFStream.WriteText FileBody, adWriteLine

  UTFStream.Position = 3 'skip BOM

  Set BinaryStream = CreateObject("adodb.stream")
  BinaryStream.Type = adTypeBinary
  BinaryStream.Mode = adModeReadWrite
  BinaryStream.Open

  UTFStream.CopyTo BinaryStream

  ' Originally I planned to use "CopyTo Dest, NumChars" to not copy the last
  ' byte.  However, NumChars is described as an integer whereas Position is
  ' described as Long. I was concerned that by "integer" they mean 16 bits.
  BinaryStream.Position = BinaryStream.Position - 1
  BinaryStream.SetEOS

  UTFStream.Flush
  UTFStream.Close
  Set UTFStream = Nothing

  BinaryStream.SaveToFile PathFileName, adSaveCreateOverWrite
  BinaryStream.Flush
  BinaryStream.Close
  Set BinaryStream = Nothing

End Sub

Part 3

In <TD align = 'left'>Card Type</TD>, align = 'left' is the default so can be omitted.

More importantly, the align attribute was depreciated in Html 4 and I cannot find it in Html 5. Use of CSS is recommended.

I suggest you output a HEAD element like this:

  <head>
    <style>
      table {border-collapse:collapse;}
      td {border-style:solid; border-width:1px; border-color:#BFBFBF;}
       tr.bc-lb {background-color:lightblue;}
       td.ha-c {text-align:center;}
      td.ha-r {text-align:right;}
    </style>
  <head>

and TR and TD elements like this:

<tr class= “bg-lb”>
<td>Card Type</td>
<td class=“ha-c“>Trans Date</td>"
<td class=“ha-r“>Trans Amt</td>"

table {border-collapse:collapse;} specifies CSS collapse table model. The difference between the collapse and separate models is only visible if you have cell borders. With collapse the borders touch but with separate there is a small gap between them.

td {border-style:solid; border-width:1px; border-color:#BFBFBF;} specifies every cell is to have a solid, thin border that is coloured dark grey which I prefer to black.

tr.bc-lb {background-color:lightblue;} allows me to set the background colour for a row to light blue by including class= “bg-lb”within the TR start tag.

I think the other styles and their use can be deduced from the above information.

Summary

Without access to your system I cannot test any rewritten versions of your code. I hope I have given you enough information to allow you to amend your own code.

Formatting two data tables in Outlook mail

1 Answers1