Export A Large Access Table/Query To Excel

The previous days I had to update a large Access database. I had a large table – around 1.000.000 records/rows – that I had to export to an Excel workbook, perform some calculations/corrections and import the table back into the database. So, you might wonder what the problem was, right? Well, the problem was the large number of records that I had to export from the Access table. Before I write some VBA code I tried two alternatives:

A) A simple copy-paste using the Clipboard. I selected the entire table and tried the CRL + C shortcut. Unfortunately, the result was the following message:

A table that contains 1.000.000 records divided by 65.000 gives around 16 groups. No way!

B) I tried the export feature of Access, but, although the Excel file was created, no data was inserted into the spreadsheet.

Being disappointed by my previous attempts, I decided to try a VBA solution. So, I wrote a VBA function that can export a large Access table into an Excel spreadsheet.

VBA code

The following lines of code constitute the aforementioned VBA function (DataToExcel), plus a small sub that make use of the function (Test).

Option Compare Database
Option Explicit

Sub Test()
    
    'Change the names according to your own needs.
    DataToExcel "Sample_Table", "Optional Workbook Path", "Optional Target Sheet Name"
                
    'Just showing that the operation finished.
    MsgBox "Data export finished successfully!", vbInformation, "Done"
    
End Sub 
 
 
Function DataToExcel(strSourceName As String, Optional strWorkbookPath As String, Optional strTargetSheetName As String)

    'Use this function to export a large table/query from your database to a new Excel workbook.
    'You can also specify the name of the worksheet target.
    
    'strSourceName is the name of the table/query you want to export to Excel.
    'strWorkbookPath is the path of the workbook you want to export the data.
    'strTargetSheetName is the desired name of the target sheet.
    
    'By Christos Samaras
    'http://www.myengineeringworld.net
   
    Dim rst         As DAO.Recordset
    Dim excelApp    As Object
    Dim Wbk         As Object
    Dim sht         As Object
    Dim fldHeadings As DAO.Field
        
    'Set the desired recordset (table/query).
    Set rst = CurrentDb.OpenRecordset(strSourceName)
    
    'Create a new Excel instance.
    Set excelApp = CreateObject("Excel.Application")
    
    On Error Resume Next
    
    'Try to open the specified workbook. If there is no workbook specified
    '(or if it cannot be opened) create a new one and rename the target sheet.
    Set Wbk = excelApp.Workbooks.Open(strWorkbookPath)
    If Err.Number <> 0 Or Len(strWorkbookPath) = 0 Then
        Set Wbk = excelApp.Workbooks.Add
        Set sht = Wbk.Worksheets("Sheet1")
        If Len(strTargetSheetName) > 0 Then
            sht.Name = Left(strTargetSheetName, 34)
        End If
    End If
    
    'If the specified workbook has been opened correctly, then in order to avoid
    'problems with other sheets that might contain, a new sheet is added and is
    'being renamed according to the strTargetSheetName.
    Set sht = Wbk.Worksheets.Add
    If Len(strTargetSheetName) > 0 Then
        sht.Name = Left(strTargetSheetName, 34)
    End If
            
    On Error GoTo 0
    
    excelApp.Visible = True
                               
    On Error GoTo Errorhandler

    'Write the headings in the target sheet.
    For Each fldHeadings In rst.Fields
        excelApp.ActiveCell = fldHeadings.Name
        excelApp.ActiveCell.Offset(0, 1).Select
    Next
    
    'Copy the data in the target sheet.
    rst.MoveFirst
    sht.Range("A2").CopyFromRecordset rst
    sht.Range("1:1").Select
    
    'Format the headings of the target sheet.
    excelApp.Selection.Font.Bold = True
    With excelApp.Selection
        .HorizontalAlignment = -4108 '= xlCenter in Excel.
        .VerticalAlignment = -4108  '= xlCenter in Excel.
        .WrapText = False
        With .Font
            .Name = "Arial"
            .Size = 11
        End With
    End With
    
    'Adjusting the columns width.
    excelApp.ActiveSheet.Cells.EntireColumn.AutoFit
    
    'Freeze the first row - headings.
    With excelApp.ActiveWindow
        .FreezePanes = False
        .ScrollRow = 1
        .ScrollColumn = 1
    End With
    sht.Rows("2:2").Select
    excelApp.ActiveWindow.FreezePanes = True
    
    'Change the tab color of the target sheet.
    With sht
        .Tab.Color = RGB(255, 0, 0)
        .Range("A1").Select
    End With

    'Close the recordset.
    rst.Close
    Set rst = Nothing

Exit Function

Errorhandler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Exit Function

End Function

Bear in mind that you cannot import into an Excel worksheet more than 1048576 rows. So, if your table/query exceed that limit (1048575 rows for data + 1 for headings), the additional records will not be imported.


How to use it

I have added the above function into a VBA module named mExportToExcel. So, you can import the module and use the above function directly to your database. The video below demonstrates the whole procedure.

Download the mExportToExcel module from here

The file has been developed and tested in Access 2010, but, I suppose it can be used even with Access 2007.


A much simpler solution

The good thing with this blog is that is interactive, so I can learn from your comments, as you learn from my posts. Today a blog reader pointed out that you can avoid using the above VBA code by importing the data directly from Excel. In other words, instead of exporting the data from the Access, open your Excel workbook, go to the Data menu and select from Access. Find the Access file and select the desired table/query. That’s all! I tried it and seems to work perfectly. So, thank you my friend for your suggestion.

Did you like this post? If yes, then share it with your friends. Thank you!