Write to access from excel

Была ли эта статья полезной?

Convert Excel to Access Database

Use this simple method to learn how to create Access database from Excel spreadsheet.

Programmers convert Excel to Access database for easy maintenance, minimize the load or as a database backup. This article is going to explain how to import Excel into Access without using any ADODB or connection string. This method is going to very simple.

Instead of creating a connection string and mapping to it in SQL query every time, we are going to just do an Export in single step by using the Microsoft Access Object Library. The process explained in this article will work better in Office 2007 and above.

How to Import Excel into Access Database?

Before using the Macro code, let’s see how import Excel into Access is done manually. We need a source file (Excel) and a target destination file (MDB). Assume there is a table as in below format in an Excel sheet. To convert this Excel to Access database, create a new MDB file.

1. Open the MDB file & Choose “External Data” from Menu.
2. Choose “Excel” from the list of sources (Access, Excel, Text, XML etc) Import Tab.
3. Enter Excel file path in ‘File Name’ field in the Pop up window.
4. Choose ‘Import to new Table’ or ‘Append’ or ‘Link’ as per your requirement.
5. Click next, proceed with few more windows to choose the Sheet or view that has data.
6. click Finish to complete importing Excel  data to Access.

Now, the data from Excel will be imported to the current mdb database. Access will also ask confirmation whether you want to store the import steps, so that it will be easy to repeat the same steps in just one click.

Also Read: Different methods to Read Data from external Excel Workbook.

VBA to Export Excel to Access Database

To create Access database from Excel spreadsheet, Press Alt + F11 to view the VB Editor in Excel. Copy paste the below code, change the MDB File path and Table name as per your need.

1. Include “Microsoft Access Object Library” from Tools -> References.
2. Press F5 to execute this code and export data.

Option Explicit
'This Code is downloaded from Officetricks.com
Public Sub Export_Excel_To_Access_MDB()
    Dim oDB As New Access.Application
    
    'Create Object to Link to the Access Databse
    oDB.OpenCurrentDatabase "C:OfficeTricksExcel_To_Access.accdb", False
    
    'Import data from Excel Spreadsheet to Access Database
    oDB.DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "ExcelToAccess", ThisWorkbook.FullName, True
    
    'Import only specific data range from Excel to Access
    oDB.DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "ExcelToAccess", ThisWorkbook.FullName, True, "Sheet1$A1:E3"
    
    'Export Data from Access to a Text File
    oDB.DoCmd.TransferText acExportDelim, TableName:="ExcelToAccess", Filename:=ThisWorkbook.Path & "ExportText.txt"
    
    'Close Access Application and quit
    oDB.CloseCurrentDatabase
    oDB.Quit
    Set oDB = Nothing
    
    'Process Completed
    MsgBox "Data Exported to Access DB"
End Sub

The above code also explains how to (1) Export particular range from Excel to Access and (2) Export data from Access database to a Text file.

This page only explains about how to do a plain data transfer (i.,e directly convert Excel to Access). It does not include the explanations about how to build a SWL query, to insert, alter, and inquire data from Access. To do those processes, we have to make use of other options present in DoCmd collection of Access Application Object.

Introduction.

We can Import data from external data sources; from another Access database, dBase, FoxPro, Excel, and so on. We can Export data from Access into these Applications as well.

Following is a list of topics I have published earlier; either on importing, exporting, or working with external data sources from Microsoft Access:

• Exporting/Importing Data in Text format
• GetRows() Function and Exporting Data
• Import Objects with VB Code
• Adding Data Directly into External databases
• Link External Tables with VBA
• Linking with IBM AS400 Tables

Today, we will explore how to add a range of Excel cell data directly into Access Table, by running the VBA Code from within Excel.

The Algorithm of the program is as given below:

1. Create an Access Application Object and open it.

2. Open the target database within the Access Application.

3. Keep the Access Application window hidden.

4. Open the target table from the Database.

5. Take the count of Rows from one of the Excel data columns.

6. Open a repeating loop to write the excel data one row at a time, from the second row onwards.

7. Repeat the writing action till all the rows are transferred to the Access Table.

8. Close the table, and database, and quit the MS-Access Application.

The Excel VBA Code is Run by clicking a Command Button on the Excel Sheet. A sample image of the Excel Sheet with data and Command Button is given below:

Target Access Table Structure image is given below:

The Excel VBA Code

Sub Button1_Click()
    Dim objAcc As Object
    Dim recSet As Object
    Dim DataRow As Long, EndRow As Long
    
    On Error GoTo Button1_Click_Err
    
    'Create Access Application Object
    Set objAcc = CreateObject("Access.Application")
    'Open Database in Microsoft Access window
    objAcc.OpenCurrentDatabase "F:mdbsDatabase4XL.accdb", True
    'Keep Access application window hidden
    objAcc.Visible = False
    
    'Open Access Table to add records from Excel
    Set recSet = objAcc.CurrentDb.OpenRecordset("Table1")
    'Take actual row counts of data for transfer
    EndRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row

    With recSet
      For DataRow = 2 To EndRow
        .AddNew
        ![Desc] = Sheet1.Range("A" & DataRow).Value
        ![Qrtr1] = Sheet1.Cells.Range("B" & DataRow).Value
        ![Qrtr2] = Sheet1.Cells.Range("C" & DataRow).Value
        ![Qrtr3] = Sheet1.Cells.Range("D" & DataRow).Value
        ![Qrtr4] = Sheet1.Cells.Range("E" & DataRow).Value
        .Update
      Next
    End With
    recSet.Close
    objAcc.Quit
    Set objAcc = Nothing

Button1_Click_Exit:
Exit Sub

Button1_Click_Err:
MsgBox Err & " : " & Err.Description, , "Button1_Click()"
Resume Button1_Click_Exit
    
End Sub

Courtesy:

The non-functional raw VBA Code presented by a User at www.mrexcel.com/forum/microsoft-access, was modified by me to make it functional and was originally submitted there.

The first field of the table is an ID field with the data type AutoNumber. The ID field value is automatically generated when data is inserted into the other fields.

1. Roundup Function
   of Excel in MS-Access
2. Proper Function of
   Excel in Microsoft Access
3. Appending Data from
   Excel to Access
4. Writing Excel
   Data Directly into Access
5. Printing MS-Access
   Report from Excel
6. Copy Paste Data
   From Excel to Access2007
7. Microsoft Excel Power
   in MS-Access
8. Rounding Function
   MROUND of Excel
9. MS-Access Live Data in
   Excel
10. Access Live Data in Excel-
    2
11. Opening Excel Database
    Directly
12. Create Excel Word
    File from Access

Share:

We can export the data from Microsoft Excel to Microsoft Access by using VBA. Below is the VBA code and process which you need to paste in the code module of the file.

1. Open Excel
2. Press ALT + F11
3. VBA Editor will OPEN
4. Click anywhere in the Project Window
5. Click on Insert
6. Click on Module

7. In the Code Window, Copy and Paste the below mentioned Code

Sub ADOFromExcelToAccess()
‘ exports data from the active worksheet to a table in an Access database
‘ this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
‘ connect to the Access database
Set cn = New ADODB.Connection
cn.Open «Provider=Microsoft.Jet.OLEDB.4.0; » & _
«Data Source=C:FolderNameDataBaseName.mdb;»
‘ open a recordset
Set rs = New ADODB.Recordset
rs.Open «TableName», cn, adOpenKeyset, adLockOptimistic, adCmdTable
‘ all records in a table
r = 3 ‘ the start row in the worksheet
Do While Len(Range(«A» & r).Formula) > 0
‘ repeat until first empty cell in column A
With rs
.AddNew ‘ create a new record
‘ add values to each field in the record
.Fields(«FieldName1») = Range(«A» & r).Value
.Fields(«FieldName2») = Range(«B» & r).Value
.Fields(«FieldNameN») = Range(«C» & r).Value
‘ add more fields if necessary…
.Update ‘ stores the new record
End With
r = r + 1 ‘ next row
Loop
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

8. Once this is pasted, go to the Excel file
9. Click on the VIEW Tab on the ribbon
10. Click on Macros
11. Click on View Macros
12. The Shortcut Key to View Macros is ALT + F8
13. A Window will popup

14. Select the Macro
15. Here the Macro is named as “ADOFromExcelToAccess”
16. Select the Macro “ADOFromExcelToAccess”
17. Click on Run
18. Click OK to close the Box

This is how we can Export data from Excel to Access by using VBA in Microsoft Excel.

There are many ways to do this. Let’s look at a couple of case studies.

 Export data from Excel to Access (ADO)

If you want to export data to an Access table from an Excel worksheet, the macro example below shows how this can be done.

Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
    ' connect to the Access database
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
        "Data Source=C:FolderNameDataBaseName.mdb;"
    ' open a recordset
    Set rs = New ADODB.Recordset
    rs.Open "TableName", cn, adOpenKeyset, adLockOptimistic, adCmdTable  
    ' all records in a table
    r = 3 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0 
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("FieldName1") = Range("A" & r).Value
            .Fields("FieldName2") = Range("B" & r).Value
            .Fields("FieldNameN") = Range("C" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

Also . . .

 Export data from Excel to Access (DAO)

If you want to export data to an Access table from an Excel worksheet, the macro example below illustrates another way to do this.

Sub DAOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim db As Database, rs As Recordset, r As Long
    Set db = OpenDatabase("C:FolderNameDataBaseName.mdb") 
    ' open the database
    Set rs = db.OpenRecordset("TableName", dbOpenTable) 
    ' get all records in a table
    r = 3 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0 
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("FieldName1") = Range("A" & r).Value
            .Fields("FieldName2") = Range("B" & r).Value
            .Fields("FieldNameN") = Range("C" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
End Sub

Also . . .

Browse to a single EXCEL File and Import Data from that EXCEL File via TransferSpreadsheet (VBA)

Here’s yet another way . . .
Sub TryThis()

        Dim strPathFile As String
        Dim strTable As String, strBrowseMsg As String
        Dim strFilter As String, strInitialDirectory As String
        Dim blnHasFieldNames As Boolean

        ' Change this next line to True if the first row in EXCEL worksheet
        ' has field names
        blnHasFieldNames = False

        strBrowseMsg = "Select the EXCEL file:"

        ' Change C:MyFolder to the path for the folder where the Browse
        ' window is to start (the initial directory). If you want to start in
        ' ACCESS' default folder, delete C:MyFolder from the code line,
        ' leaving an empty string as the value being set as the initial
        ' directory
        strInitialDirectory = "C:MyFolder"

        strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")

        strPathFile = ahtCommonFileOpenSave(InitialDir:=strInitialDirectory, _
              Filter:=strFilter, OpenFile:=False, _
              DialogTitle:=strBrowseMsg, _
              Flags:=ahtOFN_HIDEREADONLY)

        If strPathFile = "" Then
              MsgBox "No file was selected.", vbOK, "No Selection"
              Exit Sub
        End If

        ' Replace tablename with the real name of the table into which
        ' the data are to be imported
        strTable = "tablename"

        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
              strTable, strPathFile, blnHasFieldNames

        ' Uncomment out the next code step if you want to delete the
        ' EXCEL file after it's been imported
        ' Kill strPathFile

End Sub

This tutorial will cover the ways to import data from Excel into an Access Table and ways to export Access objects (Queries, Reports, Tables, or Forms) to Excel.

Import Excel File Into Access

To import an Excel file to Access, use the acImport option of DoCmd.TransferSpreadsheet :

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C:TempBook1.xlsx", True

Or you can use DoCmd.TransferText to import a CSV file:

DoCmd.TransferText acLinkDelim, , "Table1", "C:TempBook1.xlsx", True

Import Excel to Access Function

This function can be used to import an Excel file or CSV file into an Access Table:

Public Function ImportFile(Filename As String, HasFieldNames As Boolean, TableName As String) As Boolean
' Example usage: call ImportFile ("Select an Excel File",  "Excel Files", "*.xlsx",  "C:" , True,True, "ExcelImportTest", True, True,false,True)

    On Error GoTo err_handler
  
    If (Right(Filename, 3) = "xls") Or ((Right(Filename, 4) = "xlsx")) Then
                DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames
            End If
    If (Right(Filename, 3) = "csv") Then
                DoCmd.TransferText acLinkDelim, , TableName, Filename, True
    End If
    
Exit_Thing:

    'Clean up
    'Check if our linked in Excel table already exists... and delete it if so
    If ObjectExists("Table", TableName) = True Then DropTable (TableName)
    Set colWorksheets = Nothing

    Exit Function
    
err_handler:
    If (Err.Number = 3086 Or Err.Number = 3274 Or Err.Number = 3073) And errCount < 3 Then
        errCount = errCount + 1

    ElseIf Err.Number = 3127 Then
        MsgBox "The fields in all the tabs are the same. Please make sure that each sheet has the exact column names if you wish to import mulitple", vbCritical, "MultiSheets not identical"
        ImportFile = False
        GoTo Exit_Thing
    Else
        MsgBox Err.Number & " - " & Err.Description
        ImportFile = False
        GoTo Exit_Thing
        Resume
    End If
End Function

You can call the function like this:

Private Sub ImportFile_Example()
 Call VBA_Access_ImportExport.ImportFile("C:TempBook1.xlsx", True, "Imported_Table_1")
End Sub

Access VBA Export to New Excel File

To export an Access object to a new Excel file, use the DoCmd.OutputTo method or the DoCmd.TransferSpreadsheet method:

Export Query to Excel

This line of VBA code will export a Query to Excel using DoCmd.OutputTo:

DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c:tempExportedQuery.xls"

Or you can use the DoCmd.TransferSpreadsheet method instead:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c:tempExportedQuery.xls", True

Note: This code exports to XLSX format. Instead you can update the arguments to export to a CSV or XLS file format instead (ex. acFormatXLSX to acFormatXLS).

Export Report to Excel

This line of code will export a Report to Excel using DoCmd.OutputTo:

DoCmd.OutputTo acOutputReport, "Report1", acFormatXLSX, "c:tempExportedReport.xls"

Or you can use the DoCmd.TransferSpreadsheet method instead:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c:tempExportedReport.xls", True

Export Table to Excel

This line of code will export a Table to Excel using DoCmd.OutputTo:

DoCmd.OutputTo acOutputTable, "Table1", acFormatXLSX, "c:tempExportedTable.xls"

Or you can use the DoCmd.TransferSpreadsheet method instead:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c:tempExportedTable.xls", True

Export Form to Excel

This line of code will export a Form to Excel using DoCmd.OutputTo:

DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c:tempExportedForm.xls"

Or you can use the DoCmd.TransferSpreadsheet method instead:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c:tempExportedForm.xls", True

Export to Excel Functions

These one line commands work great to export to a new Excel file. However, they will not be able to export into an existing workbook.  In the section below we introduce functions that allow you to append your export to an existing Excel file.

Below that, we’ve included some additional functions to export to new Excel files, including error handling and more.

Export to Existing Excel File

The above code examples work great to export Access objects to a new Excel file.  However, they will not be able to export into an existing workbook.

To export Access objects to an existing Excel workbook we’ve created the following function:

Public Function AppendToExcel(strObjectType As String, strObjectName As String, strSheetName As String, strFileName As String)

    Dim rst As DAO.Recordset
    Dim ApXL As Excel.Application
    Dim xlWBk As Excel.Workbook
    Dim xlWSh As Excel.Worksheet
    Dim intCount As Integer
    Const xlToRight As Long = -4161
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    Const xlContinuous As Long = 1
      
    Select Case strObjectType

    Case "Table", "Query"
        Set rst = CurrentDb.OpenRecordset(strObjectName, dbOpenDynaset, dbSeeChanges)
    Case "Form"
        Set rst = Forms(strObjectName).RecordsetClone
    Case "Report"
        Set rst = CurrentDb.OpenRecordset(Reports(strObjectName).RecordSource, dbOpenDynaset, dbSeeChanges)
    End Select

    If rst.RecordCount = 0 Then
        MsgBox "No records to be exported.", vbInformation, GetDBTitle
    Else
        On Error Resume Next
        Set ApXL = GetObject(, "Excel.Application")
        If Err.Number <> 0 Then
            Set ApXL = CreateObject("Excel.Application")
        End If
        Err.Clear

        ApXL.Visible = False
        
        Set xlWBk = ApXL.Workbooks.Open(strFileName)
        Set xlWSh = xlWBk.Sheets.Add
        xlWSh.Name = Left(strSheetName, 31)

        
        xlWSh.Range("A1").Select
        Do Until intCount = rst.fields.Count
            ApXL.ActiveCell = rst.fields(intCount).Name
            ApXL.ActiveCell.Offset(0, 1).Select
            intCount = intCount + 1
        Loop

        rst.MoveFirst
        
        xlWSh.Range("A2").CopyFromRecordset rst

        With ApXL
            .Range("A1").Select
            .Range(.Selection, .Selection.End(xlToRight)).Select
            .Selection.Interior.Pattern = xlSolid
            .Selection.Interior.PatternColorIndex = xlAutomatic
            .Selection.Interior.TintAndShade = -0.25
            .Selection.Interior.PatternTintAndShade = 0
            .Selection.Borders.LineStyle = xlNone
            .Selection.AutoFilter
            .Cells.EntireColumn.AutoFit
            .Cells.EntireRow.AutoFit
            .Range("B2").Select
            .ActiveWindow.FreezePanes = True
            .ActiveSheet.Cells.Select
            .ActiveSheet.Cells.WrapText = False
            .ActiveSheet.Cells.EntireColumn.AutoFit
            xlWSh.Range("A1").Select
            .Visible = True
        End With

        'xlWB.Close True
        'Set xlWB = Nothing
        'ApXL.Quit
        'Set ApXL = Nothing
    End If
End Function

You can use the function like this:

Private Sub AppendToExcel_Example()
    Call VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBASheet", "C:TempTest.xlsx")
End Sub

Notice you are asked to define:

• What to Output? Table, Report, Query, or Form
• Object Name
• Output Sheet Name
• Output File Path and Name.

VBA Programming | Code Generator does work for you!

Export SQL Query to Excel

Instead you can export an SQL query to Excel using a similar function:

Public Function AppendToExcelSQLStatemet(strsql As String, strSheetName As String, strFileName As String)
    Dim strQueryName As String
    Dim ApXL As Excel.Application
    Dim xlWBk As Excel.Workbook
    Dim xlWSh As Excel.Worksheet
    Dim intCount As Integer
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    Const xlVAlignCenter = -4108
    Const xlContinuous As Long = 1
    Dim qdf As DAO.QueryDef
    Dim rst As DAO.Recordset
    
    strQueryName = "tmpQueryToExportToExcel"

    If ObjectExists("Query", strQueryName) Then
        CurrentDb.QueryDefs.Delete strQueryName
    End If
    Set qdf = CurrentDb.CreateQueryDef(strQueryName, strsql)
    Set rst = CurrentDb.OpenRecordset(strQueryName, dbOpenDynaset)

    If rst.RecordCount = 0 Then
        MsgBox "No records to be exported.", vbInformation, GetDBTitle
    Else
        On Error Resume Next
        Set ApXL = GetObject(, "Excel.Application")
        If Err.Number <> 0 Then
            Set ApXL = CreateObject("Excel.Application")
        End If
        Err.Clear

        ApXL.Visible = False
        
        Set xlWBk = ApXL.Workbooks.Open(strFileName)
        Set xlWSh = xlWBk.Sheets.Add
        xlWSh.Name = Left(strSheetName, 31)

        
        xlWSh.Range("A1").Select
        Do Until intCount = rst.fields.Count
            ApXL.ActiveCell = rst.fields(intCount).Name
            ApXL.ActiveCell.Offset(0, 1).Select
            intCount = intCount + 1
        Loop

        rst.MoveFirst
        
        xlWSh.Range("A2").CopyFromRecordset rst

        With ApXL
            .Range("A1").Select
            .Range(.Selection, .Selection.End(xlToRight)).Select
            .Selection.Interior.Pattern = xlSolid
            .Selection.Interior.PatternColorIndex = xlAutomatic
            .Selection.Interior.TintAndShade = -0.25
            .Selection.Interior.PatternTintAndShade = 0
            .Selection.Borders.LineStyle = xlNone
            .Selection.AutoFilter
            .Cells.EntireColumn.AutoFit
            .Cells.EntireRow.AutoFit
            .Range("B2").Select
            .ActiveWindow.FreezePanes = True
            .ActiveSheet.Cells.Select
            .ActiveSheet.Cells.WrapText = False
            .ActiveSheet.Cells.EntireColumn.AutoFit
            xlWSh.Range("A1").Select
            .Visible = True
        End With


        'xlWB.Close True
        'Set xlWB = Nothing
        'ApXL.Quit
        'Set ApXL = Nothing
    End If
End Function

Called like this:

Private Sub AppendToExcelSQLStatemet_Example()
    Call VBA_Access_ImportExport.ExportToExcel("SELECT * FROM Table1", "VBASheet", "C:TempTest.xlsx")
End Sub

Where you are asked to input:

• SQL Query
• Output Sheet Name
• Output File Path and Name.

Function to Export to New Excel File

These functions allow you to export Access objects to a new Excel workbook. You might find them more useful than the simple single lines at the top of the document.

Public Function ExportToExcel(strObjectType As String, strObjectName As String, Optional strSheetName As String, Optional strFileName As String)

    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim intCount As Integer
    Const xlToRight As Long = -4161
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    Const xlContinuous As Long = 1

    On Error GoTo ExportToExcel_Err
    DoCmd.Hourglass True

    Select Case strObjectType

    Case "Table", "Query"
        Set rst = CurrentDb.OpenRecordset(strObjectName, dbOpenDynaset, dbSeeChanges)
    Case "Form"
        Set rst = Forms(strObjectName).RecordsetClone
    Case "Report"
        Set rst = CurrentDb.OpenRecordset(Reports(strObjectName).RecordSource, dbOpenDynaset, dbSeeChanges)
    End Select

    If rst.RecordCount = 0 Then
        MsgBox "No records to be exported.", vbInformation, GetDBTitle
        DoCmd.Hourglass False
    Else
        On Error Resume Next
        Set ApXL = GetObject(, "Excel.Application")
        If Err.Number <> 0 Then
            Set ApXL = CreateObject("Excel.Application")
        End If
        Err.Clear
        On Error GoTo ExportToExcel_Err

        Set xlWBk = ApXL.Workbooks.Add
        ApXL.Visible = False

        Set xlWSh = xlWBk.Worksheets("Sheet1")
        If Len(strSheetName) > 0 Then
            xlWSh.Name = Left(strSheetName, 31)
        End If

        xlWSh.Range("A1").Select
        Do Until intCount = rst.fields.Count
            ApXL.ActiveCell = rst.fields(intCount).Name
            ApXL.ActiveCell.Offset(0, 1).Select
            intCount = intCount + 1
        Loop

        rst.MoveFirst
        
        xlWSh.Range("A2").CopyFromRecordset rst

        With ApXL
            .Range("A1").Select
            .Range(.Selection, .Selection.End(xlToRight)).Select
            .Selection.Interior.Pattern = xlSolid
            .Selection.Interior.PatternColorIndex = xlAutomatic
            .Selection.Interior.TintAndShade = -0.25
            .Selection.Interior.PatternTintAndShade = 0
            .Selection.Borders.LineStyle = xlNone
            .Selection.AutoFilter
            .Cells.EntireColumn.AutoFit
            .Cells.EntireRow.AutoFit
            .Range("B2").Select
            .ActiveWindow.FreezePanes = True
            .ActiveSheet.Cells.Select
            .ActiveSheet.Cells.WrapText = False
            .ActiveSheet.Cells.EntireColumn.AutoFit
            xlWSh.Range("A1").Select
            .Visible = True
        End With

retry:
        If FileExists(strFileName) Then
            Kill strFileName
        End If
        If strFileName <> "" Then
            xlWBk.SaveAs strFileName, FileFormat:=56
        End If
        
        rst.Close
        Set rst = Nothing
        DoCmd.Hourglass False
    End If

ExportToExcel_Exit:
    DoCmd.Hourglass False
    Exit Function

ExportToExcel_Err:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    DoCmd.Hourglass False
    Resume ExportToExcel_Exit

End Function

The function can be called like this:

Private Sub ExportToExcel_Example()
 Call VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBASheet")
End Sub