Question : Using CopyFromRecordset with recordset yields a blank worksheet. Urgent!

Ultimate Guru's!

Can't figure it out.
This should be ok and the code runs fine,  but the worksheet keeps turning up empty.
I have a little extra code from previous experiments that enumerated through the record set but it was way too slow.
Now I am trying the CopyFromRecordset method because its supposed to rock.
Can anyone see a problem in the code?
Many thanks,

Ted

Ye Olde' code=======================

Public Function QryExcel(Qry As String, Optional FolderPath As String, Optional Filename As String) As Boolean
'
'This code is used
'to create a excel chart/worksheet using Automation from within Access
'Requires a reference to Microsoft Excel Objects Library and to the Microsoft DAO 3.6 library

QryExcel = False
On Error GoTo Err_Handler
Dim I As Integer, X As Integer, Y As Integer, Z As Integer
Dim RCount As Integer
Dim FCount As Integer
Dim objExcel As Excel.Application
Dim objWorkbook As Excel.Workbook
Dim objWorksheet As Excel.Worksheet
Dim tblName As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim QD As DAO.QueryDef
Dim SQLcmd As String
Dim fld As Field
Dim RowName As String
Dim RowData As String
Dim RowNameTitle As String
Dim RowDataTitle As String
Dim RowNameField As String
Dim RowDataField1 As String
Dim RowDataField2 As String
Dim intMaxCol As Integer
Dim intMaxRow As Integer
Dim Title As String
Dim F As Integer
Const conRANGE = "RangeForRS"
Const TitleStartRow As Integer = 2
Const BodyStartRow As Integer = 5
Const One As Integer = 1


tblName = Qry

Set db = CurrentDb
Set QD = db.QueryDefs(Qry)
SQLcmd = QD.Sql
Set rs = db.OpenRecordset(SQLcmd, dbOpenSnapshot)

If rs.EOF Then
    MsgBox "Sorry - No Data Found in " & Qry & ".", vbInformation
    Exit Function
Else
    rs.MoveLast
    rs.MoveFirst
    RCount = rs.RecordCount 'Get the total number of records
    intMaxRow = RCount
End If

FCount = rs.Fields.Count    'Get the number of fields
intMaxCol = FCount

'Set objExcel = GetObject("", "excel.application")
On Error Resume Next
Set objExcel = GetObject(FolderPath & Filename, "excel.application")
If Err.Number > 0 Then
    Set objExcel = GetObject("", "excel.application")
    Set objWorkbook = objExcel.Workbooks.Add
    objWorkbook.SaveAs Filename
    Err.Number = 0
    On Error GoTo Err_Handler
Else
    Set objWorkbook = objExcel.Workbooks(0)
End If

'Make it visible.
objExcel.Visible = True

'Turn off the alerts, otherwise a user will have to confirm actions.
objExcel.DisplayAlerts = False

'See if the worksheet exist based on the queryname.
On Error Resume Next
 Set objWorksheet = objWorkbook.Worksheets(Qry)
 If Err.Number > 0 Then
   Set objWorksheet = objWorkbook.Worksheets.Add
   objWorksheet.Name = Qry
 End If
 Err.Clear


objWorkbook.Sheets(Qry).Range("A5").CopyFromRecordset rs

QryExcel = True
   
Quit_Handler:
   
    'Turn back on alerts if you would like user to be notified to save on exit.
    '    objExcel.DisplayAlerts = True
   
    'Free up memory to help squash memory leaks.
    Set objExcel = Nothing
    Set objWorksheet = Nothing
    Set objWorkbook = Nothing
   
    Exit Function

Err_Handler:
    MsgBox Err.Description, vbInformation
    'Err.Number = 0
    Resume Quit_Handler
   
End Function

Answer : Using CopyFromRecordset with recordset yields a blank worksheet. Urgent!

ok, try this for the syntax to renaming the worksheet


'Here is your line that adds the worksheet
        Set objWorksheet = objWorkbook.Worksheets.Add

'Now sheet gets added last? If so, rename last sheet to Qry
        objWorkbook.Sheets(objWorkbook.Sheets.Count).name = Qry
Random Solutions  
 
programming4us programming4us