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

Posted on 2005-03-18
Medium Priority
Last Modified: 2008-04-27
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.

Question by:yajesh
LVL 51

Expert Comment

by:Steve Bink
ID: 13575535
Shouldn't be too hard.  How strict is your 64k cutoff?  How long are your records?  How many fields?  Put up some table information, and I'm sure we can generate some code to do what you want.

Author Comment

ID: 13575763
Hi! Routinet,

I believe that Excel Spreadsheet has limitation on the number of row/records. (64K).

The number of fields may vary depending the tbales I access.

What I would like is some sort of a generic VBA Access code to take possibly the records output from Access Database  (generated by the SQL Query) and upon completing the SQL rotine. create multuple Excel Spreadsheets in an incremental order.

It is easy to write chunk program in C, but my user does not want to use C - Strictly VBA from Access.

LVL 51

Expert Comment

by:Steve Bink
ID: 13575960
Give me an hour or so to code and test it, and I'll come back and post a working sub for you.  This should not be too difficult.  :)  

Just so I'm clear, you want this to be able to export the results of ANY query/SQL you pass to it into an Excel spreadsheet, divided into individual, consecutively numbered worksheets of no more than, say, 60000 records each, yes?
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!


Author Comment

ID: 13576764

Please note! The limittaion of number of records is merely due to the largest size of spreadsheet you can have. This is why we have to do this exercise.

LVL 51

Expert Comment

by:Steve Bink
ID: 13577870
Okay, got it.  There are a couple things you should be aware of, though:

1) There are three constants at the beginning.  These are module-level constants, and only provide a simple way to change the operating parameters.  They should be relatively self-explanatory.  You can create a sub to allow the user to pick a filename, and use that instead of the SaveAsFileName constant.
2) The error handling is on a VERY basic level.  You may want to add more detail to it.
3) I'm not sure what the column limit is on Excel, but this does not check for it.

Let me know if you have any issues.
LVL 51

Accepted Solution

Steve Bink earned 2000 total points
ID: 13577880
' 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
    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"
        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)

' 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.
' 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
        xCurrent = 2
    End If
    For xCount = 1 To rs.Fields.Count
        xlSheet.Cells(xCurrent, xCount) = rs.Fields(xCount - 1).Value

' Delete the placeholder sheet, and save the file using the name provided by the module-level constant.
' Close the recordset.
xlBook.SaveAs SaveAsFileName

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

' Clean up and destroy all objects.

Set rs = Nothing
Set db = Nothing

Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

End Sub

Author Comment

ID: 13578323
Thanks! routinet,

I will takeover from here.

I sincerely appreciate your immediate attention.
LVL 15

Expert Comment

by:Simon Ball
ID: 13666215
superb.  i think the excel data max sizes has to do with binary numbers...

i think the max columns is 256 (2^8)

max rows is 65536 ( including header row) (2^16)

LVL 51

Expert Comment

by:Steve Bink
ID: 13666404
That's exactly why.  You'll notice that many of the limits we hit as programmers, including hard drive size, it due to binary limits.

Expert Comment

ID: 21167635
I am very impressed with your expertise here . As such, I have tested it at my end and it works great for me.

I have opened a new thread at the link below with a view to enhancing your current code, therefore, I have introduced a new twist to the new question hoping you would kindly assist.



Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Implementing simple internal controls in the Microsoft Access application.
A Case Study of using the Windows API to provide RS232 communications capability in Access without the use of Active-X controls.
With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…
Visualize your data even better in Access queries. Given a date and a value, this lesson shows how to compare that value with the previous value, calculate the difference, and display a circle if the value is the same, an up triangle if it increased…
Suggested Courses

578 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question