Question : Chunk rows of records into 64K blocks and create .xls files..

Hi!
I need some help in assembling the VBA Access code to do the following:

The SQL query will extract may be 150,000 rows from the Access database using a specific criteria

What I would like to do is chunk these records (may be .csv output) into smaller groups (64K) and create .xls file automatically. e.g  sheet1.xls  sheet2.xls   sheet3.xls etc.....

I need to do all this within VBA Access code.

yaj

Answer : Chunk rows of records into 64K blocks and create .xls files..

' Three constants
' NumRowsMax = how many rows (maximum, including row headers) will be exported to each sheet.
' SaveAsFileName = the FULL PATH AND FILENAME to where you would like Excel to save the data.
' sQueryName = the name of the query, or the full SQL, for the recordset to be exported.

Const NumRowsMax = 200
Const SaveAsFileName = "C:\ExcelExport.xls"
Const sQueryName = "MyQueryName"

' This routine exports the results of the query.
Public Sub ExportToExcel()
Dim xlApp As Object
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim xCount
Dim xCurrent
Dim xSheetNum

' Basic error handling for creating the Excel object.
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
    Err.Clear
    Set xlApp = CreateObject("Excel.Application")
    If Err.Number <> 0 Then
        MsgBox "There was an unknown error while attempting to open Excel.  The export did not complete"
        xlApp.Quit
        Set xlApp = Nothing
        GoTo AllDone
    End If
End If

' Set up the error handling to notify the user of any miscellaneous problems.
On Error GoTo ErrHandler

' Save the option to be changed, reset to 1 worksheet per new workbook, and create the workbook.
' Rename the active sheet to "DELETEME" for future reference.  This sheet will not hold data.
' Restore the changed option, and make Excel visible.
xSheetNum = xlApp.SheetsInNewWorkbook
xlApp.SheetsInNewWorkbook = 1
Set xlBook = xlApp.Workbooks.Add
xlBook.ActiveSheet.Name = "DELETEME"
xlApp.SheetsInNewWorkbook = xSheetNum
xlApp.Visible = True
xlApp.DisplayAlerts = False

' Set up our recordset with the query named in the module-level constant.
' Use the Move methods to fully populate the recordset.
Set db = CurrentDb
Set rs = db.OpenRecordset(sQueryName)
rs.MoveLast
rs.MoveFirst

' Loop to export recordset data.  This loop ends when the recordset hits the end of data.
' Create a new sheet if the current row is past the cutoff defined by the module-level constant.
' If a new sheet has been made, set the name to be in order, and export field names to the first row.
' DATA EXPORT STARTS ON THE SECOND ROW!!
' Populate cells, starting with column 1, with data from each field in the recordset.
' Move to the next record and start over.
xCurrent = 0
xSheetNum = 0
Do Until rs.EOF
    xCurrent = xCurrent + 1
    If xCurrent > NumRowsMax Then xCurrent = 1
    If xCurrent = 1 Then
        xSheetNum = xSheetNum + 1
        Set xlSheet = xlBook.Worksheets.Add(xlBook.Worksheets(xlBook.Worksheets.Count))
        xlSheet.Name = "Sheet" & xSheetNum
        For xCount = 1 To rs.Fields.Count
            xlSheet.Cells(xCurrent, xCount) = rs.Fields(xCount - 1).Name
        Next
        xCurrent = 2
    End If
    For xCount = 1 To rs.Fields.Count
        xlSheet.Cells(xCurrent, xCount) = rs.Fields(xCount - 1).Value
    Next
    rs.MoveNext
Loop

' Delete the placeholder sheet, and save the file using the name provided by the module-level constant.
' Close the recordset.
xlBook.Worksheets("DELETEME").Delete
xlBook.SaveAs SaveAsFileName
rs.Close

' The error handler for anything after creating the Excel object.
ErrHandler:
    If Err.Number <> 0 Then
        MsgBox "Error number " & Err.Number & " occured during the export process.  The export may not have completed."
        Err.Clear
    End If

AllDone:
' Clean up and destroy all objects.

Set rs = Nothing
Set db = Nothing

Set xlSheet = Nothing
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing

End Sub