Exporting ACCESS To Excel 1

[chip12]

I ran a query that came back with 145,000 rows of information. I need to export that to excel. However Excel will only except 65,536 rows. I need some sort of workaround on this.

 

[wemeier]

Excel can't load more than 65,536 rows, so I assume you're asking how to break up the query results into multiple Excel worksheets.

There is a way to do this with using the TOP query parameter, but it will make the query run VERRRRRRY long as it requires running the query multiple times -- each time excluding the dynaset of the previous query.

Another way to do it would be to populate a temporary table from the query. Create the temporary table first and include an autonumber field. Change your query to an append query and run it to populate the table.

Then, create a query to extract only the first 65,356 rows by including a WHERE expression of:

WHERE [autonumberfieldname] \ 65356 = 0

Run the query, then change the WHERE clause to:

WHERE [autonumberfieldname] \ 65356 = 1

Run the query again with a different workbook name. Continue running these queries until all "pages" have been exported. You could automate this someone it VBA code.

You may have to change 65356 to 65355 depending on whether or not you want the first row of each spreadsheet to contain the column headings.

Sorry it's not more elegant, but it's the best I can come up with other than creating a VBA function that using ADO (or DAO) to create an Excel workbook, create blank worksheets then populate each cell of the sheet with data from the query.

Cruising the Information Superhighway
[sub] (your mileage may vary)[/sub]

 

[wemeier]

I didn't like my last reply, so I did some research and created an Access function that will create an Excel workbook with as many worksheets as are needed to contain all of the data you wish to export:

Public Function ExportToExcel(QueryName As String, Optional ByVal WorkbookName As String = "", Optional RowsPerSheet As Long = 65356, Optional FirstRowHeadings As Boolean = True) As Boolean
[COLOR=green]'   Export the results of a query to Excel, creating multiple worksheets
'   if the number of rows exceeds the maximum number of rows per sheet (an optional variable).[/color]
    Dim db As Database
    Dim rst As Recordset
    Dim appExcel As Excel.Application
    Dim wkbExcel As Excel.Workbook
    Dim wksExcel As Excel.Worksheet
    Dim intFields As Integer
    Dim intWorksheet As Integer
    Dim intCol As Integer
    Dim lngRow As Long

[COLOR=green]'   Set error handling[/color]
    ExportToExcel = False
    On Error GoTo ExportToExcel_Err
    
[COLOR=green]'   If no workbook name given, use the query name and put it in the current directory[/color]
    If WorkbookName = "" Then WorkbookName = QueryName & ".xls"
    
[COLOR=green]'   Create the Excel Application and Workbook[/color]
    Set appExcel = Excel.Application
    Set wkbExcel = appExcel.Workbooks.Add
    
[COLOR=green]'   Initialize the worksheet to 1[/color]
    intWorksheet = 1
    
[COLOR=green]'   Open the query[/color]
    Set db = CurrentDb()
    Set rst = db.OpenRecordset(QueryName)
    intFields = rst.Fields.Count
    
[COLOR=green]'   Walk the query's output to build the workbook.
'   Start by creating and formatting a new worksheet.
'   Fill in worksheet rows from the query until you reach
'   the end of the query or you reach the maximum number
'   of rows in the worksheet.
'   If you reach the maximum number of rows in the worksheet,
'   create and format another worksheet and repeat the process.[/color]
    While Not rst.EOF
        On Error Resume Next
        Set wksExcel = appExcel.Worksheets("Sheet" & intWorksheet)
        If Err.Number = 9 Then
            appExcel.Worksheets.Add.Move After:=appExcel.Worksheets(appExcel.Worksheets.Count)
            Set wksExcel = appExcel.Worksheets("Sheet" & intWorksheet)
            wksExcel.Visible = xlSheetVisible
        End If
        appExcel.Visible = True
    
    [COLOR=green]'   Initialize the worksheet font[/color]
        With wksExcel
            Cells.Font.Name = "Arial"
            Cells.Font.Size = 10
            Cells.Font.StrikeThrough = False
            Cells.Font.Superscript = False
            Cells.Font.Subscript = False
            Cells.Font.OutlineFont = False
            Cells.Font.Shadow = False
            Cells.Font.Underline = xlUnderlineStyleNone
            Cells.Font.ColorIndex = xlAutomatic
             
        [COLOR=green]'   If the first row will be the header, make the first row bold and freeze it[/color]
            If FirstRowHeadings = True Then
                .Rows("1:1").Font.Bold = True
                .Rows("1:1").Interior.ColorIndex = 15
                .Rows("1:1").Interior.Pattern = xlSolid
                .Rows("1:1").Interior.PatternColorIndex = xlAutomatic
                .Rows("2:2").Select
                appExcel.ActiveWindow.FreezePanes = True
            End If
             
        [COLOR=green]'   Also make the first row print on every page if the sheet is printed[/color]
            If FirstRowHeadings = True Then
                ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
                ActiveSheet.PageSetup.PrintTitleColumns = ""
            End If
            
        [COLOR=green]'   Also set up the header and footer to identify the data[/color]
            .PageSetup.LeftHeader = QueryName            [COLOR=green]' Name of query[/color]
            .PageSetup.CenterHeader = ""
            .PageSetup.RightHeader = ""
            .PageSetup.LeftFooter = "&F"                 [COLOR=green]' File name[/color]
            .PageSetup.CenterFooter = "&D"               [COLOR=green]' Today's date[/color]
            .PageSetup.RightFooter = "&P of &N"          [COLOR=green]' Page x of y[/color]
            .PageSetup.PrintHeadings = False
            .PageSetup.PrintGridlines = False
            .PageSetup.PrintComments = xlPrintNoComments
            .PageSetup.PrintQuality = 600
            .PageSetup.CenterHorizontally = False
            .PageSetup.CenterVertically = False
            .PageSetup.Orientation = xlPortrait
            .PageSetup.Draft = False
            .PageSetup.FirstPageNumber = xlAutomatic
            .PageSetup.Order = xlDownThenOver
            .PageSetup.BlackAndWhite = False
             
        [COLOR=green]'   Create column headers for each field in the query (if first row is to contain headings[/color]
            lngRow = 1
            If FirstRowHeadings = True Then
                For intCol = 0 To intFields - 1
                    .Cells(1, intCol + 1).Value = rst.Fields(intCol).Name
                Next intCol
                lngRow = 2
            End If
        
        [COLOR=green]'   Loop through the recordset adding rows to the worksheet[/color]
            Do Until rst.EOF Or lngRow > RowsPerSheet
                 For intCol = 0 To intFields - 1
                     .Cells(lngRow, intCol + 1).Value = rst.Fields(intCol).Value
                 Next
                 lngRow = lngRow + 1
                 rst.MoveNext
            Loop
       
        [COLOR=green]'   Resize the columns to fit the data[/color]
            .Cells.Select
            .Cells.EntireColumn.AutoFit
           
        [COLOR=green]'   Set the focus back at the first data cell[/color]
            If FirstRowHeadings = True Then
                .Range("A2").Select
            Else
                .Range("A1").Select
            End If
            
        [COLOR=green]'   Make sure the worksheet is visible[/color]
            wksExcel.Visible = xlSheetHidden
            wksExcel.Visible = xlSheetVisible
        End With
        
    [COLOR=green]'   Increment the worksheet number[/color]
        Set wksExcel = Nothing
        intWorksheet = intWorksheet + 1
    
    Wend
             
[COLOR=green]'   Save the file using the name provided[/color]
    appExcel.ActiveWorkbook.SaveAs WorkbookName
 
[COLOR=green]'   Cleanup Excel objects[/color]
    Set wkbExcel = Nothing
    Set appExcel = Nothing

[COLOR=green]'   Close the recordset[/color]
    rst.Close
    Set db = Nothing
    
    ExportToExcel = True
    
ExportToExcel_Exit:
    Exit Function
    
ExportToExcel_Err:
    MsgBox Err.Description
    Resume ExportToExcel_Exit
End Function

You can call this function from a macro or from VBA code. The only required field is the name of the table or query to export.

You can optionally specify the workbook name (including the path), how many rows can fit on a worksheet (in case you're using an older version of Excel) and whether or not you want the first row to contain column headings.

For example, using the Northwind database that comes with Access:

Resp = ExportToExcel("Products") will export the contents of the "Products" table to a new workbook named "Products.xls".

Resp = ExportToExcel("Products","C:\My Documents\Northwind Products.xls") will export the contents of the "Products" table to a new workbook named "Northwind Products.xls" in the directory "C:\My Documents".

Resp = ExportToExcel("Products","C:\My Documents\Northwind Products.xls",32678,False) will export the contents of the "Products" table to a new workbook named "Northwind Products.xls" in the directory "C:\My Documents" with 32,678 rows per worksheet and with no column headings in the first row.

Cruising the Information Superhighway
[sub] (your mileage may vary)[/sub]

 

[JerryKlmns]

wemeier

I think you ve missed some ([red].[/red]) where you
' Initialize the worksheet font
With wksExcel
Cells.Font.Name = "Arial"

and should add
' Cleanup Excel objects
wkbExcel.Close
Set wkbExcel = Nothing
appExcel.Quit
Set appExcel = Nothing


BUT! You surely deserve a * for that. I would suggest you make it a FAQ!

 

[wemeier]

JerryKlmns,

Thanks for the star! You're right, I left out the periods in front of the Cells objects when I was copying the code onto Tek-Tips.

I deliberately left the .Close and .Quit out of my function so I would leave the spreadsheet open (sortta like the Autostart option when exporting to Excel using the wizard), but it's a good idea to include them in the function (maybe with another optional parameter called "Autostart" that would control it).


Cruising the Information Superhighway
[sub] (your mileage may vary)[/sub]