• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• Convert ado recordset to HTML or CSV in ONLY 1 line of code!

Convert ado recordset to HTML or CSV in ONLY 1 line of code!

Convert ado recordset to HTML or CSV in ONLY 1 line of code!

Rate Convert ado recordset to HTML or CSV in ONLY 1 line of code!

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'  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