Hi,
I'm having an issue with my LOOPING AND SAVING CODE for MSACCESS.
I have a file that has 1.5 million rows. I need to pull 4000 at a time then export it to a workbok and save that work book with the row number range in the file name. example
Test_1_4000.xls
Test_4001_8000.xls
Here is my code. I shortened the number of rows needed in the code for testing purposes.
The problem is that when I run the code All 20 rows export not just 5 and my save file gets and error.
I would LOVE someones help on this. I don't want to export manually.
Option Explicit
Sub Export2Excel()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim fileName As Object
Dim intMaxCol As Integer
Dim intMaxRow As Integer
Dim x1APP As Excel.Application
Dim objWkb As Workbook
Dim objSht As Worksheet
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
I'm having an issue with my LOOPING AND SAVING CODE for MSACCESS.
I have a file that has 1.5 million rows. I need to pull 4000 at a time then export it to a workbok and save that work book with the row number range in the file name. example
Test_1_4000.xls
Test_4001_8000.xls
Here is my code. I shortened the number of rows needed in the code for testing purposes.
The problem is that when I run the code All 20 rows export not just 5 and my save file gets and error.
I would LOVE someones help on this. I don't want to export manually.
Option Explicit
Sub Export2Excel()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim fileName As Object
Dim intMaxCol As Integer
Dim intMaxRow As Integer
Dim x1APP As Excel.Application
Dim objWkb As Workbook
Dim objSht As Worksheet
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