Search code examples
vbaexceladoms-access-2003

CopyFromRecordset method isn't moving the cursor to last row output


I am using ADO to query a table in MS Access 2003, and outputting the data to Excel 2003 worksheets using the CopyFromRecordset method.

The table has more than 65536 records, so I cannot use DoCmd.TransferSpreadsheet and need to use VBA with ADO.

My problem is that after making a call to CopyFromRecordset even though only 65536 records are output, the cursor stays at 1 (AbsolutePosition=1) when according to my understanding, the cursor should be at 65537, ready for the next call to CopyFromRecordset

Here below is the code I am using:

Dim oXL As Excel.Application
Dim adoConn As ADODB.Connection
Dim adoRS As ADODB.Recordset
Dim iIndx As Integer

Dim blnMultipleSheets As Boolean

Set adoConn = New ADODB.Connection
Set adoRS = New ADODB.Recordset

With adoConn
    .CursorLocation = adUseClient
    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=O:\Dev\Support\Recurring_Requests\Future_Deals_Notice_InterestValues_Rates_Data\Future Deals.mdb;Persist Security Info=False"
    .Open
End With

With adoRS
    .CursorType = adOpenForwardOnly
    .ActiveConnection = adoConn
    .CursorLocation = adUseClient
    .Source = "SELECT * FROM Future_Deals_InterestValues_Rates_Data"
    .Open
End With

Set oXL = New Excel.Application

With oXL
    If .Version < 12 Then
        blnMultipleSheets = True
    Else
        blnMultipleSheets = False
    End If

    .Visible = True
    .Workbooks.Add

    .Range("B2").CopyFromRecordset adoRS
    If adoRS.RecordCount > .ActiveSheet.Rows.Count Then
        Do While Not adoRS.EOF
            .Sheets.Add
            Range("B2").CopyFromRecordset adoRS
        Loop
    End If
End With

so what am I missing here?


Solution

  • This line

    .Range("B2").CopyFromRecordset adoRS
    

    pastes the entire recordset placing it at B2 as the left-top coordinates.

    So, remove your loop and the above line.

    You can loop through the recordset like this(pseudocode):

    Function pasteRecordSet(ByRef adoRS)
        For i = 1 To adoRS.RecordCount
            If i > 65536 Then
                new sheet
                + you can call here recursively
            Else ' on the current sheet
                adoRS.MoveNext
                If (adoRS.EOF) Then
                    adoRS.MoveFirst
                End If
        Next i
    End Function