Export Query to Excel 2003 over multiple sheets

Can someone please help me finish this code:

This code takes a query, modifies it for a loop, exporting the data sets by week. Some weeks however are bigger than others. It exports fine, but crashes if the query resulted in a larger than 65536 source.

I need it to export it to multiple sheets for that book if it is too big.

Thanks in advance!
Option Compare Database

Sub Weeklies()

' code requires reference to Microsoft DAO library

    Dim xlApp As Object
    Dim xlWb As Object
    Dim xlWs As Object
    Dim xlWsInWb As Long
    Dim Arr As Variant
    Dim Counter As Long
    Dim rs As DAO.Recordset
    Dim ColumnCount As Long
    Dim xMod, xLob As String
    Dim xDate As Integer
        
    mySQLStr = "SELECT myTable.* FROM myTable WHERE (((Format([Date],'xMod'))=xDate) AND ((myTable.[LOB Adj])='xLOB'));"
    
    UseSqlStr = mySQLStr
    
    yMod = "ww"
    yLOB = "TeamA"
    
    
    
    For period = 1 To 13
    Debug.Print "Building week: " & period
    
            UseSqlStr = Replace(UseSqlStr, "xMod", yMod) ' Change period from ww, to mm if want months
            UseSqlStr = Replace(UseSqlStr, "xDate", period) ' Could be weeks or months
            UseSqlStr = Replace(UseSqlStr, "xLOB", yLOB) ' Change to Bell Canada, Sympatico, Bell Mobility, Bell Expressvu..
        
            Set xlApp = CreateObject("Excel.Application")
            Set xlWb = xlApp.Workbooks.Add
            xlWsInWb = xlApp.SheetsInNewWorkbook
            xlApp.SheetsInNewWorkbook = 2 ' Depends on how many rows returned
            xlApp.SheetsInNewWorkbook = xlWsInWb
            
            Set rs = CurrentDb.OpenRecordset(UseSqlStr)
            rsNum = rs.RecordCount 'Determine how many records
                        
            Set xlWs = xlWb.Worksheets(1)
            
            With xlWs
                'Write headings into sheet
                For ColumnCount = 1 To rs.Fields.Count
                    .Cells(1, ColumnCount) = rs.Fields(ColumnCount - 1).Name
                Next
                
                .Cells(2, 1).CopyFromRecordset rs
                .Name = yLOB & " " & period
                
            End With
            
            rs.Close
            UseSqlStr = OBSqlStr
            
                'xlApp.Visible = True
                xlWb.SaveAs "C:\Documents and Settings\testing\" & yLOB & " - " & period & ".xls"
                xlWb.Close
                Debug.Print "File Saved!"
                                
                Set xlWs = Nothing
                Set xlWb = Nothing
                Set xlApp = Nothing
            Next
End Sub

Open in new window

AfterlifeAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

RDWaibelCommented:
Couple of Ideas here...

1)  Set your RS to have a page size of 65536.  Then Export the first page, if rs.pages > 1, switch to the next page in the work sheet, apply the header row, then set the RS to the second page, copy that result to the new excel page.

2)  You could "write" one line at a time in order to catch the error.  Once the counter hits 65536, switch to a new page in the record set, apply the heading, continue with the line export.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Andrew_WebsterCommented:
I seem to remember that you'd be well advised to do an rs.MoveLast before you check the RecordCount to make sure you've got the exact number.

Next, I'd also put in an error handler to make sure that even if something breaks you get to quit Excel - I've done stuff like this before and found a whole bunch of instances of Excel merrily running invisible and only closeable through Task Manager.  Ow!

Lastly, I'd also make sure you use Option Explicit and declare all your variables.  Not using Option Explicit is cause for buying the coffee for a week in any team I run!

How's this for a suggestion: get the RecordCount, and use it to determine how many sheets you'll need to create.  Then use a filter on the recordset to reduce the size to one sheet's worth of 65535 records and copy it (maybe even clone it - I'm writing on my feet here so apologies if I'm talking b*llocks in the details).  Then use CopyFromRecordset to get it into the first sheet.  Filter it again for the next 65535-odd records, and keep doing that until you're done.

Or, right enough, start writing in A1 and iterate through the fields and the row of the recordset writing it into the cells of the sheets until your done.

Sorry, I'm not being precise as I'm not on a machine with Access on it, but I've done a load of work like this before now, and it rocks when you get it right.  Top tip: if you want to wow the users when you first show them how it works. make sure that Excel is open and they can see it all writing.  It's going to look just like "real" computing on the TV!
0
Richard DanekeTrainerCommented:
Invest in Excel 2007.  It offers over 1,000,000 rows to a worksheet.
0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

Richard DanekeTrainerCommented:
or download the Excel 2010 beta for free at Microsoft's web site.
0
AfterlifeAuthor Commented:
@DoDahD: my work laptop can not handle 2007, and its available to me. I should get a new laptop later in the summer but for now no way.
0
AfterlifeAuthor Commented:
No code example
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.