rambosh
asked on
copy a vb6 recordset to excel.
I'm looking for a function that would be similar to this command in Visual FoxPro. If you have query results in foxpro, you can say "Copy to (filename).xls type xls" and it generates an excel file with your data. Is there a similar funciton in VB 6.0? I've already generated spreadsheets manually by creating a reference to an excel object and populating all of the cells. This is very time consuming when you have multiple spreadsheets to generate. What I want to do is get a recordset and copy that whole recordset to a spreadsheet. I do not need headers, titles, etc. Is there anyway possible to do this?
ASKER
No. How would you do that? Looks like you have to have an instance of excel open in vb? As well as an instance of a workbook and worksheet? (I imagine in your example, "ws" stands for the instance of the worksheet?) Say if I have a recordset called RecXLData. Would my command be: ws.range("A1").copyfromrec ordset RecXLData? Does it only copy the data? or the field names as well?
Here is some working code demonstrating the CopyFromRecordset method. This leaves Excel open. If you wish to save the spreadsheet to a file, read the comments. It would be easy to convert this to a reusable sub where one passes in the recordset and a filename to save the Excel file to.
Private Sub doIt()
Dim oXL As Excel.Application: Set oXL = New Excel.Application
If Not IsObject(oXL) Then
MsgBox "You need Microsoft Excel to use this function", vbCritical + vbOKOnly, "Excel Error"
Exit Sub
End If
Dim oBookXL As Excel.Workbook: Set oBookXL = oXL.Workbooks.Add
Dim oSheetXL As Excel.Worksheet: Set oSheetXL = oXL.ActiveSheet
'' set these to false if you're saving to a file without opening Excel
oXL.UserControl = True
oXL.Visible = True
Dim cn As ADODB.Connection: Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=SQLOLEDB.1;Integ rated Security=SSPI;Persist Security Info=False;Initial Catalog=Pubs;Data Source=<< your database here >>"
cn.Open
Dim rs As ADODB.Recordset: Set rs = cn.Execute("SELECT * FROM Authors")
oSheetXL.Range("A1").CopyF romRecords et rs
' Uncomment these to save to a file
' oXL.ActiveWorkbook.SaveAs sPathAndFileName, xlCSV
' oXL.Quit
cn.Close
Set cn = Nothing
Set oSheetXL = Nothing
Set oBookXL = Nothing
set oXL = nothing
End Sub
Private Sub doIt()
Dim oXL As Excel.Application: Set oXL = New Excel.Application
If Not IsObject(oXL) Then
MsgBox "You need Microsoft Excel to use this function", vbCritical + vbOKOnly, "Excel Error"
Exit Sub
End If
Dim oBookXL As Excel.Workbook: Set oBookXL = oXL.Workbooks.Add
Dim oSheetXL As Excel.Worksheet: Set oSheetXL = oXL.ActiveSheet
'' set these to false if you're saving to a file without opening Excel
oXL.UserControl = True
oXL.Visible = True
Dim cn As ADODB.Connection: Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=SQLOLEDB.1;Integ
cn.Open
Dim rs As ADODB.Recordset: Set rs = cn.Execute("SELECT * FROM Authors")
oSheetXL.Range("A1").CopyF
' Uncomment these to save to a file
' oXL.ActiveWorkbook.SaveAs sPathAndFileName, xlCSV
' oXL.Quit
cn.Close
Set cn = Nothing
Set oSheetXL = Nothing
Set oBookXL = Nothing
set oXL = nothing
End Sub
ASKER
ok. I got the data to save to the spreadsheet from the above function. Is there a way to set the column names or insert a row into row 1 with the column headers. I tried, but it didn't like it. I know when you are writing rows, you use syntax like for i = 1 to ???. .range("A"&i).value = xxxxx. Since the columns are character, I was sure how to do it if the number of columns is not predetermined. Any suggestions?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Hey,
************************** *
ADO Recordset Method
GetString(StringFormat, NumRows, ColumnDelimiter, RowDelimiter, NullExpr)
************************** *
dim strValues as string
dim strFields as string
dim fld as ADODB.Field
dim strFile as string
dim rst ad ADODB.Recordset
rst.open query, con
for each fld in rst.fields
strFields = strFields & fld.name & vbTab
next
strFields = Left(strFields,len(strFiel ds) - 1) & vbCrLf
strValues = rst.GetString(adClipString , , vbTab, vbCrLf, "")
strFile = strfields & strvalues
open "c:\test.xls" for binary as #1
put #1,,strFile
close #1
hope this helps
Curtis
**************************
ADO Recordset Method
GetString(StringFormat, NumRows, ColumnDelimiter, RowDelimiter, NullExpr)
**************************
dim strValues as string
dim strFields as string
dim fld as ADODB.Field
dim strFile as string
dim rst ad ADODB.Recordset
rst.open query, con
for each fld in rst.fields
strFields = strFields & fld.name & vbTab
next
strFields = Left(strFields,len(strFiel
strValues = rst.GetString(adClipString
strFile = strfields & strvalues
open "c:\test.xls" for binary as #1
put #1,,strFile
close #1
hope this helps
Curtis
ASKER
thanks a bunch for your help. I did get the headers working.
ws.Range("A1").CopyFromRec