Generate an HTML Table String from a Query’s Recordset

HTML Document Icon

I was trying to help out in an MSDN thread in which the user was trying to include an HTML table from their query.

Below was my solution to export a query, or table, as a HTML Table string which then can be used in e-mails, to generate standalone HTML files, …


As such, I put together the following function to take a query, open it up (evaluating any parameters if need be) and then generate a HTML table string of the resulting recordset. It will use the query’s field names as a header row (unless you specify False for bInclHeader, the function’s 2nd argument) and then inserts a row per record.

'---------------------------------------------------------------------------------------
' Procedure : GenHTMLTable_Query
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Generate an HTML Table string from a Query's Resulting Recordset
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sQuery        : Name of the query to use to create the HTML Table string from
' bInclHeader   : True/False whether to include a header row with the field names
'
' Usage:
' ~~~~~~
' sMsg = GenHTMLTable_Query("YourQueryName") 'With a Header Row
' sMsg = GenHTMLTable_Query("YourQueryName", FALSE) 'No Header Row
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2017-02-14              Initial Release
' 2         2018-09-20              Updated Copyright
' 3         2021-12-17              Implemented thead and tbody for proper table HTML
' 4         2023-05-18              Fix location of tbody tags
' 5         2023-05-19              Renamed function
'---------------------------------------------------------------------------------------
Function GenHTMLTable_Query(sQuery As String, Optional bInclHeader As Boolean = True) As String
    On Error GoTo Error_Handler
    Dim db                    As DAO.Database
    Dim qdf                   As DAO.QueryDef
    Dim prm                   As DAO.Parameter
    Dim rs                    As DAO.Recordset
    Dim fld                   As DAO.Field
    Dim sHTML                 As String

    Set db = CurrentDb
    Set qdf = db.QueryDefs(sQuery)

    For Each prm In qdf.Parameters
        prm = Eval(prm.Name)
    Next prm

    Set rs = qdf.OpenRecordset
    With rs
        sHTML = "<table>" & vbCrLf
        'sHTML = "<table border='1' style='border-collapse:collapse;'>" & vbCrLf
        If bInclHeader = True Then
            'Build the header row if requested
            sHTML = sHTML & vbTab & "<thead>" & vbCrLf
            sHTML = sHTML & vbTab & vbTab & "<tr>" & vbCrLf
            For Each fld In rs.Fields
                sHTML = sHTML & vbTab & vbTab & vbTab & "<th>" & _
                        fld.Name & "</th>" & vbCrLf
            Next
            sHTML = sHTML & vbTab & vbTab & "</tr>" & vbCrLf
            sHTML = sHTML & vbTab & "</thead>" & vbCrLf
        End If
        If .RecordCount <> 0 Then
            sHTML = sHTML & vbTab & "<tbody>" & vbCrLf
            Do While Not .EOF
                'Build a row for each record in the recordset
                sHTML = sHTML & vbTab & vbTab & "<tr>" & vbCrLf
                For Each fld In rs.Fields
                    sHTML = sHTML & vbTab & vbTab & vbTab & "<td>" & _
                            fld.Value & "</td>" & vbCrLf
                Next
                sHTML = sHTML & vbTab & vbTab & "</tr>" & vbCrLf
                .MoveNext
            Loop
            sHTML = sHTML & vbTab & "</tbody>" & vbCrLf
        End If
        sHTML = sHTML & "</table>"
    End With

    GenHTMLTable_Query = sHTML

Error_Handler_Exit:
    On Error Resume Next
    If Not fld Is Nothing Then Set fld = Nothing
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    If Not db Is Nothing Then Set db = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: GenHTMLTable_Query" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

If you’re looking to export a Table, rather than a Query, be sure to check out: