VB and VBA Users Source Code: Display the results of an ADO recordset in a HTML table
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Display the results of an ADO recordset in a HTML table
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Wednesday, August 08, 2001
Hits:
821
Category:
Internet/Remote Comms
Article:
Option Explicit The following example function can be used on an ASP page to display the results of an ADO recordset in HTML. <% 'Purpose : Outputs the result of a recordset to a table 'Inputs : oRs The opened recordset containing the rows to display ' sTitle The title of the table, if Empty then no title is printed. ' lWidth The width of the table in percent, if Empty the 100% is used. ' lBorder The table border, if Empty the 1 is used. ' lDateFormat The date format for any date values found in the recordset, ' if Empty the vbLongDate is used. ' sHideCols A comma seperated string containing a list of the columns to hide, ' if Empty all columns in the recordset are visible, ' eg "1,2" would hide the 2nd and 3rd columns. ' lAnchorCol The index of the column within the HTML table to contain an anchor tag. ' If empty no anchors are added. ' sAnchorText The static anchor text used in the column specified by lAnchorCol. ' eg. could be "http://www.MyWebSite/GetThisArticle.asp?ArticleID=" ' or "mailto:" ' lAnchorParamCol The number of the column in the recordset which contains the anchor text to append to ' sAnchorText. ' eg. would be the column in the recordset containing the ArticleID for the above example. ' or would be the column contains the email address for the "mailto:" text. 'Outputs : Returns -1 on failure else returns the number of rows in the table. 'Author : Andrew Baker 'Date : 8/Aug/2001 'Notes : Function RStoTable(oRS, sTitle, lWidth, lBorder, lDateFormat, sHideCols, lAnchorCol, sAnchorPage, lAnchorParamCol) Dim lNumRows, lNumCols, avResults Dim lThisCol, lThisRow On Error Resume Next 'Set up default parameters If IsNumeric(lWidth) = False Then lWidth = 100 End If If IsNumeric(lBorder) = False Then lBorder = 1 End If If IsNumeric(lDateFormat) = False Then lDateFormat = vbLongDate End If 'Get results into array If oRst.EOF = False Then avResults = oRst.GetRows(-1) lNumRows = UBound(avResults, 2) + 1 lNumCols = UBound(avResults, 1) + 1 RStoTable = lNumRows End If If Len(sHideCols) Then 'Format the comma seperated string 'containing the columns to hide If Left(sHideCols, 1) <> "," Then sHideCols = "," & sHideCols End If If Right(sHideCols, 1) <> "," Then sHideCols = sHideCols & "," End If sHideCols = Replace(sHideCols, " ", "") End If If Len(lAnchorCol) = 0 Then lAnchorCol = -1 End If 'Display header Response.Write "<BR><TABLE cellSpacing=0 cellPadding=0 width=""" & lWidth & "%"" border=" & lBorder & ">" If Len(sTitle) Then 'Display title Response.Write "<tr><td colspan=" & lNumCols & "><P align=center><b>" & sTitle & "</b></p></td></tr>" End If 'Display results For lThisRow = -1 To lNumRows - 1 Response.Write "<tr>" For lThisCol = 0 To lNumCols - 1 If InStr(1, sHideCols, "," & lThisCol & ",") = 0 Then 'Display this column If lThisRow = -1 Then 'Write column header Response.Write "<td><b><i>" & oRst.Fields(lThisCol).Name & "</b></i></td>" & vbNewLine Else 'Write row results If IsNull(avResults(lThisCol, lThisRow))=True Then 'Write a null cell Response.Write "<td> </td>" & vbNewLine ElseIf Len(avResults(lThisCol, lThisRow))=0 Then 'Write an empty cell Response.Write "<td> </td>" & vbNewLine ElseIf oRst.Fields(lThisCol).Type = 7 Then 'Write a date cell If lAnchorCol = lThisCol Then 'Write date anchor row Response.Write "<td><a HREF=" & sAnchorPage & avResults(lAnchorParamCol, lThisRow) & ">" & FormatDateTime(avResults(lThisCol, lThisRow), lDateFormat) & "</a></td>" & vbNewLine Else 'Write a date value Response.Write "<td>" & FormatDateTime(avResults(lThisCol, lThisRow), lDateFormat) & "</td>" & vbNewLine End If Else 'Write other data type row If lAnchorCol = lThisCol Then 'Write anchor row Response.Write "<td><a HREF=" & sAnchorPage & avResults(lAnchorParamCol, lThisRow) & ">" & avResults(lThisCol, lThisRow) & "</a></td>" & vbNewLine Else 'Write normal cell Response.Write "<td>" & Replace(avResults(lThisCol, lThisRow), vbNewLine, "<BR>") & "</td>" & vbNewLine End If End If End If End If Next Response.Write "</tr>" Next Response.Write "</TABLE>" 'Close Recordset oRS.Close If Err.Number Then 'Return failure code RStoTable = -1 Response.Write "<B>Failed to output recordset results: " & Err.Description End If End Function 'Example usage: 'Connect to Database sMappedPath = Server.MapPath("\mydb.mdb") Set oCon = Server.CreateObject("adodb.connection") oCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sMappedPath & "; Persist Security Info=False" 'Open recordset Set oRst = Server.CreateObject("adodb.recordset") oRst.Open "Select * from qryStats", oCon, adOpenForwardOnly 'Center the table on the page Response.Write "<P align=center>" 'Display results RStoTable oRst, "Summary Statistics Table", 50, 1, vbLongDate, "","","","" Response.Write "</P>" 'Close recordset Set oRst = Nothing oCon.Close Set oCon = Nothing %>
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
