by Anthony Loera (7 Submissions)
Category: Databases/Data Access/DAO/ADO
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 23rd August 2001
Date Added: Mon 8th February 2021
Rating: (1 Votes)
Convert ado recordset to HTML or CSV in ONLY 1 line of code!
' You are free to use this code within your own applications,
' but you are forbidden from being a dummy and not making
' the source code available to everyone except ... Mike G who
' is not allowed to use this code, view this code, get ideas
' from this code, edit this code, smell this code, etc, etc...
' =============================================================
' Copyright ©2001 Anthony L =============================================================
'Example of Use - CSV
Private Sub Command1_Click()
dim rs as adodb.recordset
rs.Open "SELECT * FROM Authors", "DSN=Pubs"
'the one liner is below
if RecordsetToCSV(rs, "C:\Excel.csv") = true then msgbox "Created Excel CSV"
set rs = nothing
End Sub
'Example of Use - HTML
Private Sub command2_Click()
dim rs as adodb.recordset
rs.Open "SELECT * FROM Authors", "DSN=Pubs"
'the one liner is below
if DOHTML(rs, "C:\Excel.csv") = true then msgbox "Created HTML File"
set rs = nothing
End Sub
'Converts your rs to EXCEL compatible CSV file (unlike Mike Gs junk)
Public Function RecordsetToCSV(byval rs As ADODB.Recordset, byval strPath as string) as boolean
strTmp As String
Open strPath For Output As #1
RecordsetToCSV = False
Print #1, """"
Do Until rs.EOF
' shoots blocks of 100 rows for speed
tmp = rs.GetString(, 100, """,""", """" & vbCrLf & """", "")
If rs.EOF Then
' drop the extra double quoted character sent
tmp = Left$(tmp, Len(tmp) - 1)
End If
Print #1, tmp;
Loop
RecordsetToCSV = True
End FunctionClose #1
End Function
'Convert rs to super simplistic HTML table
Public Function DOHTML(byval rs As ADODB.Recordset, byval strPath as string) as boolean
dim MakeHTML as string
MakeHTML = rs.GetString(adClipString, -1, "</TD><TD>","</TD></TR>" & vbCrLf & "<TR><TD>", "(NULL)")
MakeHTML = "<TR><TD>" & Left(MakeHTML, Len(MakeHTML) - 8):MakeHTML = "<TABLE> " & MakeHTML & "</TABLE>"
Open strPath For Output As #1
Print #1, MakeHTML
Close #1
End Function