Rubrik: Datenbanken · ADO | VB-Versionen: VB5, VB6 | 18.01.05 |
Recordset nach HTML mit Format (ADO) Mit diesem Tipp lässt sich ein beliebiges Recordset in eine HTML-Tabellenstruktur exportieren. | ||
Autor: Roland Wutzke | Bewertung: | Views: 12.821 |
www.vb-power.net | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Mit dem heutigen Tipp möchten wir Ihnen zeigen, wie Sie ein beliebiges ADO-Recordset in eine HTML Tabellenstruktur bringen können.
Die Funktion RstToHTML liefert Ihnen dazu die reine Struktur in einem String zurück. Dadurch wird die Routine sehr flexibel verwendbar.
Der gelieferte Datenstream wird zusätzlich direkt formatiert zurückgegeben. Dabei werden boolesche, numerische, Währungs- und Datumsfelder berücksichtigt.
Fügen Sie den nachfolgenden Code in ein Modul ein:
' ************************************************************************* ' * ' * RstToHTML - beliebiges Recordset nach HTML exportieren (ADO) ' * ' * Mit dieser Funktion lässt sich ein beliebiges Recordset in ' * eine HTML Tabelle exportieren. Die Routine liefert Ihnen ' * lediglich die HTML-Tabellenstruktur in einem String zurück. ' * ' * Januar 2005 - VB-Power.net www.vb-power.net ' * ' ************************************************************************* Option Explicit Public Function RstToHTML(Rst As ADODB.Recordset, _ Optional WithHeader As Boolean = True) As String Dim tField As ADODB.Field Dim expString As String Dim hedString As String Dim tmpString As String Dim vTmp As Variant Dim x As Long Dim y As Long If Rst Is Nothing Then Exit Function With Rst ' Recordset in ein 2D Array holen vTmp = .GetRows ' HTML Tabellenkopf generieren expString = "<TABLE CELLPADDING=0 CELLSPACING=0 BORDER=1>" & vbCrLf ' HTML Tabellenheader generieren If WithHeader Then hedString = "<TR><TH nowrap>" For Each tField In .Fields hedString = hedString & tField.Name & "</TH><TH nowrap>" Next tField hedString = Left(hedString, Len(hedString) - 16) & "</TH></TR>" & vbCrLf expString = expString & hedString End If ' HTML Tabellenfelder generieren For x = 0 To UBound(vTmp, 2) tmpString = tmpString & "<TR>" For y = 0 To UBound(vTmp, 1) Select Case .Fields(y).Type ' boolesches Feld Umwandlung, Align Center Case adBoolean tmpString = tmpString & _ "<TD nowrap align=""center"">" & _ IIf(vTmp(y, x), "X", " ") & "</TD>" ' Hier noch zwei weitere Möglichkeiten ' einer boolschen Darstellung. ' ======================================= ' IIf(vTmp(y, x), "Ja", "Nein") & "</TD>" ' CStr(vTmp(y, x)) & "</TD>" ' Währungsfeld mit Format, Align Right Case adCurrency tmpString = tmpString & _ "<TD nowrap align=""right"">" & _ CStr(FormatCurrency(vTmp(y, x), 2)) & "</TD>" ' Datumsfeld mit Format(dd.mm.yyyy), Align Right Case adDBTimeStamp, adDBDate, adDate, adDBTime tmpString = tmpString & _ "<TD nowrap align=""right"">" & _ CStr(FormatDateTime(vTmp(y, x), vbShortDate)) & "</TD>" ' numerisches Feld mit Align Right Case adTinyInt, adSmallInt, adInteger, adBigInt, _ adSingle, adDouble, adDecimal, adNumeric tmpString = tmpString & _ "<TD nowrap align=""right"">" & CStr(Format(vTmp(y, x))) & "</TD>" ' alle anderen Felder mit Standard Align Case Else tmpString = tmpString & "<TD nowrap>" & _ IIf(IsNull(vTmp(y, x)) Or vTmp(y, x) = "", " ", CStr(vTmp(y, x))) & "</TD>" End Select Next y tmpString = tmpString & "</TR>" & vbCrLf Next x ' HTML Tabellenfuß generieren expString = expString & tmpString & vbCrLf & "</TABLE>" End With ' Rückgabewert setzen RstToHTML = expString End Function
Wie gesagt: die Funktion liefert einen String. Das nachfolgende Beispiel zeigt Ihnen, wie Sie aus VB heraus damit eine HTML-Seite erzeugen können:
Private Sub Command1_Click() Dim F As Integer F = FreeFile Open App.Path & "\Export.html" For Output As #F Print #F, "<HTML>" Print #F, "<HEAD>" ' CSS Style Sheet Print #F, "<STYLE TYPE=""Text/css"">" Print #F, "<!--" Print #F, "TABLE {font-family: Verdana; font-size: 8pt;}" Print #F, "TH {background: #FFFFC0; color: #000000;}" Print #F, "-->" Print #F, "</STYLE>" Print #F, "</HEAD>" Print #F, "<BODY>" ' Das Recordset oRst in eine HTML Tabelle umwandeln Print #F, RstToHTML(oRst) Print #F, "</BODY>" Print #F, "</HTML>" Close #F End Sub