Exporting An ADO recordset to Excel

[Bob]

I use XP Developer, W2K, and will be changing from DAO to ADO due to the
backend being MySQL.

I have looked at numerous postings, but cannot find an answer to what I am
trying to solve. Lots of pro/cons regarding ADO, but it's not my
decision...

Purpose of the code: Provide the means for users to select items from two
list boxes and export matching records (cross tab) to excel. Include
definitions on a second sheet of the Excel SS.

The code creates two queries using querydef create.

Next, using code modeled after Access Cookbook, O'Reilly, pg 583: I can
successfully copied data from the crosstab query into the first worksheet,
but not the second.

The Code:
Public Function CreateExcelSS()

Dim rst As ADODB.Recordset
Dim rst2 As ADODB.Recordset
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xl2Sheet As Excel.Worksheet
Dim i As Integer
Dim FC As Byte ' # fields from crosstab query.
On Error GoTo HandleErr


Set xlApp = New Excel.Application ' Create Excel Application object
Set xlBook = xlApp.Workbooks.Add ' Create a new workbook

xlApp.DisplayAlerts = False
xlApp.DisplayAlerts = True
xlApp.Worksheets.Add

' Capture reference to first worksheet
Set xlSheet = xlBook.ActiveSheet
xlSheet.Name = conSheetName ' Change the worksheet name

' Create recordset
Set rst = New ADODB.Recordset
Set rst2 = New ADODB.Recordset
rst.Open _
Source:=conQuery, _
ActiveConnection:=CurrentProject.Connection
FC = rst.Fields.Count
With xlSheet
For i = 1 To FC
' Copy field names to Excel using count of fields, which is
necessary because
' the number of output fields in a crosstab query is not fixed.
' Bold the column headings and insert field names. Starting
position A1. The variable 'i'
' advances the cursor one cell to the right for each additional
field.
With .Cells(1, i)
.Value = rst.Fields(i - 1).Name
.Font.Bold = True
End With
Next
' Copy all the data from the recordset into the spreadsheet.
.Range("A2").CopyFromRecordset rst

' Format the data
' Causes all columns to autofit.
For i = 1 To FC
.Columns(i).AutoFit
Next
End With
rst.Close
Stop ' Problem copying second recordset into SS.
' Create 2nd recordset
rst2.Open _
Source:="qryGeneRef", _
ActiveConnection:=CurrentProject.Connection
'------------
xlBook.Worksheets("Sheet1").Activate
Set xl2Sheet = xlBook.ActiveSheet
xl2Sheet.Name = "Gene_Ref"
With xl2Sheet
Range("A2").CopyFromRecordset rst2
End With
rst2.Close
'--------

'Display the Excel chart
xlApp.Visible = True
' xlApp.close
ExitHere:
On Error Resume Next
' Clean up
rst.Close
Set rst = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
Exit Function

HandleErr:
MsgBox Err & ": " & Err.Description, , "Error in CreateExcelSS"
Resume ExitHere
Resume
End Function



Thanks for looking.
Bob

 

[Bob]

To All:

Thanks June MacLeod. She noticed that I negelected to add a dot before the
Range object.