CopyFromRecordset only Returning 1 Record

[time2hike]

I have searched the web and the questions asked on this forum and I have not been able to find an answer to my problem. Could you please help?

I have an ADODB.Recordset that is loading and returns a record count of 22,158 records. I am trying to load these records into Excel without the user having to save the file, so I am using CopyFromRecords et instead of TransferSpreads heet. The code is working the only problem is it is only transfering the 1st record. I keep trying to change Row 46 to give me the entire recordset but I have not hit on a solution yet. Please Help!

Private Sub cmd_XprtXls_Click()
On Error GoTo Err_cmd_XprtXls_Click

    Dim conn As ADODB.Connection
    Dim stPath As String
    Dim rst As ADODB.Recordset
    Dim sSQL As String
        
    Dim xlApp As Object
    Dim xlWb As Object
    Dim xlWs As Object
    Dim acRng As Variant
    Dim slRow As Integer
    
    ' Set the string to the path of your database
    stPath = CurrentDb.Name
    ' Open connection to the database
    Set conn = New ADODB.Connection
    conn.Provider = "Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & stPath & ";"
    conn.Open
    ' Open recordset
    Set rst = New ADODB.Recordset
    sSQL = sSelect & vbCrLf & sFrom & vbCrLf & sWhere & vbCrLf & sGroupBy & vbCrLf & sHaving & ";"
    
    Debug.Print sSQL
    rst.Open sSQL, CurrentProject.Connection, adOpenStatic, adLockReadOnly
    rst.MoveLast
    Debug.Print rst.RecordCount '(Returns 22158 as RecordCount)

    ' Create an instance of Excel and add a workbook
    Set xlApp = New Excel.Application
    Set xlWb = xlApp.Workbooks.Add
    Set xlWs = xlWb.Worksheets("Sheet1")
  
    ' Display Excel and give user control of Excel's lifetime
    xlApp.Visible = True
    xlApp.UserControl = True
    
    ' Copy field names to the first row of the worksheet
    fldCount = rst.Fields.Count
    For iCol = 1 To fldCount
        xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
    Next
        
    ' Copy the recordset to the worksheet, starting in cell A2
    xlWs.Range("A2").CopyFromRecordset rst
    ' Auto-fit the column widths and row heights
    xlApp.Selection.CurrentRegion.Columns.AutoFit
    xlApp.Selection.CurrentRegion.Rows.AutoFit

    ' Close ADO objects
    rst.Close
    conn.Close
    Set rst = Nothing
    Set conn = Nothing
    
    ' Release Excel references
    Set xlWs = Nothing
    Set xlWb = Nothing

    Set xlApp = Nothing

[Oralloy]

time2hike,

Perhaps you need to specify a range large enough to take the entire recordset, not just one cell?

Oralloy

[time2hike]

I am not sure how to specify a larger range. I thought that by leaving the end of the range empty it would expand to the size of my recordset. If the range was the problem wouldn't I get only the value in A2?

My original code for line 47 was

xlWs.Cells(2, 1).CopyFromRecordset rst

This code returned the same 1 record. I tried making the 1 in the Cells(2,1) = rst.RecordCount but it gave me an error. Everything I have seen says this code should work. I appreciate any help you can provide.

[Rabbit]

CopyFromRecords et requires that you specify a range large enough to hold all the data. The Cells collection will only return a range of one cell. Use the Range method instead.

[time2hike]

I changed the Range.

' Copy the recordset to the worksheet, starting in cell A2
    xlWs.Range("A2", "S250").CopyFromRecordset rst

And I am still getting 1 record. I was expecting 250 of my recordset to export to Excel. Help!

[Rabbit]

I see no reason why it wouldn't work. Unless it's because you did a MoveLast... It's just a shot in the dark but try doing a MoveFirst right before your CopyFromRecords et.

[time2hike]

Thank you Rabbit! The Move First was the Answer.

I have included the final code that works and exports all the records I need exported below for anyone else who is having this problem.

    rst.Open sSQL, CurrentProject.Connection, adOpenStatic, adLockReadOnly
    If rst.BOF And rst.EOF Then
        MsgBox "No Data Available to Export", vbOKOnly, "No Data"
        Exit Sub
    End If
    rst.MoveLast

    Debug.Print rst.RecordCount
    iRow = rst.RecordCount + 1
    
    ' Create an instance of Excel and add a workbook
    Set xlApp = New Excel.Application
    Set xlWb = xlApp.Workbooks.Add
    Set xlWs = xlWb.Worksheets("Sheet1")
  
    ' Display Excel and give user control of Excel's lifetime
    xlApp.Visible = True
    xlApp.UserControl = True
    
    ' Copy field names to the first row of the worksheet
    fldCount = rst.Fields.Count
    For iCol = 1 To fldCount
        xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
    Next
    
    rst.MoveFirst
    
    ' Copy the recordset to the worksheet, starting in cell A2
    xlWs.Range("A2", "XFD" & iRow).CopyFromRecordset rst

    ' Auto-fit the column widths and row heights
    xlApp.Selection.CurrentRegion.Columns.AutoFit
    xlApp.Selection.CurrentRegion.Rows.AutoFit

[Rabbit]

Glad you got it working.

On a side note, you may want to include an additional check in there to see if the number of rows goes over the max in Excel. I don't know how big your recordset can get but it's something you should be aware of.