count rows then save those rows into excel file with # of rows in name

[bgrove]

Hi Need help with my code. I have an access query with 1.6 million rows. I need to count 4000 rows then move those rows to an excel spreadsheet then count the next 4000 rows and move to a new excel spreadsheet and continue until all the rows are in different excel spreadsheets.

My looping / counting code is pulling in all of the rows instead of just the 4,000 thus creating an error because excel cannot handle that many rows in one sheet.

Does anybody have some successful looping/ counting then saving code I could see?

Thank you in advance for any time and effort I receive.

Here is my code.....

Sub Export2Excel()
    
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    'Dim fileName As Object
    Dim x1APP As Excel.Application
    'Dim objWkb As Workbook
    'Dim objSht As Worksheet
    Dim i As Integer
    Dim j As Integer
    Dim Counter As Integer
    'Dim objFSO As String
    'Dim objFile As String
    
    '1)Identify the database and query
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Pinterest_Query", dbOpenDynaset)
    
    '2)check for records in query
    If rs.EOF And rs.BOF Then
    MsgBox "Query or SQL returned no records."
    Exit Function
    End If
 
    '3)Clear previous contents
    Dim xlApp As Object
    Set xlApp = CreateObject("Excel.Application")
    With xlApp
        .Visible = True
        .Workbooks.Add
        .Sheets("Sheet1").Select
            
    '4)Add column headings
     For i = 1 To rs.Fields.Count
            xlApp.ActiveSheet.Cells(1, i).Value = rs.Fields(i - 1).Name
        Next i
        xlApp.Cells.EntireColumn.AutoFit
        
    '5) Find Number of records in recordset
        Counter = rs.RecordCount
        
    '6) Loop through rows to move to a temp file for export to excel
    
     
         For i = 1 To Int(Counter / 5) + 1
            For j = 1 To 5
                If Not rs.EOF Then
                ActiveSheet.Range("a2").CopyFromRecordset rs
                rs.MoveNext
                End If
            Next
        Next
   
    End With

[zmbd]

More than likely it's because of these two lines

Set rs = db.OpenRecordse t("Pinterest_Qu ery", dbOpenDynaset)

ActiveSheet.Ran ge("a2").CopyFr omRecordset rs

Your record set, rs, is what is defined in the "Pinterest_Quer y"; therefor, if that is pulling the 1.6 million data records, then that is what you are dumping to the worksheet.

Hopefully you are using ACC2010 or newer so that you can use the TempVars collection and a stored query.

Set the query to return your records with a where clause that uses the between verb and the TempVars set by your code based on the record count chunked as you desire.

because this method hasn't been used a lot a simple example:


For example:

SELECT tblpuke1.id
    , tblpuke1.puke
    , tblpuke1.puke2
FROM tblpuke1
WHERE (((tblpuke1.id) Between 
            [TempVars]![ztvar_start] 
        And 
            [TempVars]![ztvar_end]));

So if you were to run this as is, nothing would be returned because the [id] is a primary key and neither of the conditionals are set (they are null) so there are no matching records.
Now, in VBA use the tempvars.add method you can set the values...
In this case, I'll use the immediate window (cool hey)

tempvars.Add name:= "ztvar_start", value:= 1
?tempvars!ztvar_start
 1 
tempvars.Add name:= "ztvar_end", value:= 3
?tempvars!ztvar_end
 3

And now the record set only returns the records that match that criteria.

Now, the tempvars collection is persistent, that is, they're "sticky" and have to be cleared either via code or closing down the current Access instance (close the program). So, once again via the immediate window:

tempvars.RemoveAll
?tempvars!ztvar_start
Null
?tempvars!ztvar_end
Null

I could have removed each value seperately - but that's too much work.

Now you should be able to take this information and setup your code to select the correct records.

Rewrite your code and let us know how you make out with your project.
(^_^)