vba - MS Access-CopyFromRecordset

Question

I am using below code to fetch records from a db. I have more than 5,000,000 records. The below code pulls 1048576 records and pastes in Sheet 2. Can someone help me to loop it so that it pulls all records and places it from sheet1 than sheet2 than sheet3 until all records are pasted.

Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "Sheet2"
Const conWKB_NAME = "\workbook pathacWork.xlsm"
  Set db = CurrentDb
  Set objXL = New Excel.Application
  Set rs = db.OpenRecordset("Database", dbOpenSnapshot)
  With objXL
    .Visible = True
    Set objWkb = .Workbooks.Open(conWKB_NAME)
    On Error Resume Next
    Set objSht = objWkb.Worksheets(conSHT_NAME)
    If Not Err.Number = 0 Then
      Set objSht = objWkb.Worksheets.Add
      objSht.Name = conSHT_NAME
    End If
    Err.Clear
    On Error GoTo 0
    intLastCol = objSht.UsedRange.Columns.Count
    With objSht
      .Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
          intLastCol)).ClearContents
      .Range(.Cells(1, 1), _
        .Cells(1, rs.Fields.Count)).Font.Bold = True
      .Range("A2").CopyFromRecordset rs
    End With
  End With
  Set objSht = Nothing
  Set objWkb = Nothing
  Set objXL = Nothing
  Set rs = Nothing
  Set db = Nothing
End Sub

Answer 1

Not a full answer, as not sure of the structure of the table, but using a table with a primary key, I did the following, you'll need to do a count of the records and set the loop up according to that, but something along these lines

Sub test()

    Dim strsql As String
    Dim l As Long
    Dim x As Long  ' x will be recordcount/ l

    l = 10000   ' max rows

    For x = 1 To 3
        strsql = "select top " & l & " y.* from (" & _
                "Select top " & (x * l) & " * from [Table] order by [ID] desc" & _
                ") as Y order by y.id asc"
        Debug.Print strsql 
    Next x

    End Sub

This generates SQL like so

select top 10000 y.* from (Select top 10000 * from [Table] order by [ID] desc) as Y order by y.id asc
select top 10000 y.* from (Select top 20000 * from [Table] order by [ID] desc) as Y order by y.id asc
select top 10000 y.* from (Select top 30000 * from [Table] order by [ID] desc) as Y order by y.id asc

EDIT

Sub test()

    Dim strsql As String
    Dim l As Long
    Dim x As Long  ' x will be recordcount/ l
    dim rst as adodb.recordset

    l = 10000

    For x = 1 To (dcount("id","table")/l)
        strsql = "select top " & l & " y.* from (" & _
                "Select top " & (x * l) & " * from [Table] order by [ID] desc" & _
                ") as Y order by y.id asc"
    set rst=new adodb.recordset
    rst.open strSQL, currentproject.connection, adOpenKeySet
        worksheets(x).range("a1").copyfromrecordset rst
    Next x

End Sub

Hope this helps