Visual Basic Programming Code Examples

Display the results of an ADO recordset in a HTML table 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 ' 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. 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 Else 'Return success code RStoTable = -1 Exit Function 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 %>