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.....
Expand|Select|Wrap|Line Numbers
- 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