Export results of one query to many excel workbooks and save to folders

[b.grove]

I did try your example and it copied 20 rows to excel and then I got error 3021 NO CURRENT RECORD. on the rs.movenext

[June7]

As I understand it, CopyFromRecordset automatically copies all the records from the recordset, no looping records needed.

The Do Until does not apply. Must open the recordset filtered to the set to be exported and export the whole thing.

[b.grove]

I can change my query to add the Row_ID. So each row will be numbered 1 to 1.595,240

Can you help me with my loop syntax? Pretty please?

Set RS = db.OpenRecordset
Row_ID = RS.RecordCount
If Row_ID = 0 Then
MsgBox "No records to export."
Else
RS.MoveLast
RS.MoveFirst
Do Until Row_ID = 4,000
Row_ID = Row_ID + 1
then

objExcel.ActiveWorkbook.Save
RS.MoveNext
Loop

would you mind sharing the code you are using

"I do have code that loops through a recordset x records and repeats the loop until end of recordset. I am writing to a temp table, not Excel but same idea"

[June7]

I did share a condensed version of the code in that post. What you show is nothing like that example. Follow the example and adapt to your db. Instead of 10 you would use 4000.

Your code does not open a recordset. The Set RS = db.OpenRecordset line is incomplete.

Set RS = db.OpenRecordset("table/query name or SELECT statement")

[b.grove]

I did share a condensed version of the code in that post. What you show is nothing like that example. Follow the example and adapt to your db. Instead of 10 you would use 4000.

Your code does not open a recordset. The Set RS = db.OpenRecordset line is incomplete.

Set RS = db.OpenRecordset("table/query name or SELECT statement")

Good Morning June,
I really appreciate your help. This is wonderful! Here is my code with your recommendations. For testing purposes I'm using "5" as the number of rows I'm looping through and I'm only using 20 rows in my query. when I run the code it still pulls 20 records even when my loop shows 5. Then of course I get an END OF DATA error. what am I doing wrong? It should just pull the 5 rows then save to a file, clear rs, then select the next 5 rows, save to a different excel file. then do this until all 20 rows are accounted for.

SELECT top 20 V6_subset_20140228_v2.master_id AS [Image Number], CollectionID_enterprisecollID_House.ENTERPRISE_COL LECTION_ID AS Brand, "USD" AS [Currency Code], ".025074597" AS [Gross Amount], "31-Oct-13" AS [Sale Date], "PF20131025" AS [invoice Number], "3041" AS [Use Code], "3" AS [Industry Code], "" AS [Territory Identification], "31" AS [MetaTerritory Identification], "1-Oct-13" AS [Rights Start Date], "31-Oct-13" AS [Rights End Date], "1" AS Protection, V6_subset_20140228_v2.HEADLINE AS [Description of Image], V6_subset_20140228_v2.PhotograherCredit AS [Artist Name], "PINTEREST METADATA" AS [End Customer Name], "" AS [Job Reference], "" AS [Order ID]
FROM V6_subset_20140228_v2 INNER JOIN CollectionID_enterprisecollID_House ON V6_subset_20140228_v2.COLLECTION_ID = CollectionID_enterprisecollID_House.COLLECTION_ID;

Sub Export2Excel()

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim x1APP As Excel.Application
Dim i As Integer
Dim j As Integer


'1)Identify the database and query
Set db = CurrentDb
Set rs = db.OpenRecordset("Pinterest_Query", dbOpenDynaset)

'2)Clear previous contents
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.Workbooks.Add
.Sheets("Sheet1").Select


'3)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

'4)count number of rows and copy to worksheet

For i = 1 To Int(rs.RecordCount / 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


rs.Close
Set rs = Nothing
xlApp.Quit
Set xlApp = Nothing


End Sub

[June7]

That is not quite the suggestion I originally offered.

In my procedure, ALL records meeting filter criteria are retrieved. However, I output only x records at a time. Say the recordset has 120 records and I want 24 records written at a time. The loop will iterate 5 times.

I do this for an unusual report where records must print left to right and a CROSSTAB query was not feasible. Each sheet can hold 24 records. I send first 24 records of recordset to temp table that will actually create a single record by populating 24 fields. Then the loop repeats and next 24 records create another record in temp table, repeats until all 120 records are processed. Then print report based on the temp table and 5 pages are generated.

However, as stated earlier, CopyFromRecordset should not need to iterate through the records. It should copy the ENTIRE recordset in one action.
If Not rs.EOF Then
ActiveSheet.Range("a2").CopyFromRecordset rs
End If

If you want to use that method, your code would have to filter the recordset by criteria for range of unique identifier and repeatedly open and close recordset within a loop. The trick will be figuring out how many interations of the loop. Something like:

Dim intCount As Integer, intStart As Integer
intIteration = DCount("*", "Pinterest_Query") / 5 + 1
intStart = 1
For i = 1 to intIteration
   'code to set Excel objects
   ...
   Set rs = db.OpenRecordset("SELECT * FROM Pinterest_Query WHERE UniqueID BETWEEN " & intStart & " AND " & intStart + 5, dbOpenDynaset)
   If Not rs.EOF Then
      ActiveSheet.Range("a2").CopyFromRecordset rs
   End If
   intStart = intStart + 6
   'code to close Excel objects
   ...
   rs.Close
Next