How To Have Access Export A Table To An Excel XLSX In VBA

This was regarding a question I received from this blog:

Hello, I am hoping to find some help. I have an Access DB that I use
to collect data. I have a number of different reporting features. I
would like to add the option for my user to export to excel. When I do
this with a DoCMD code that data exports but now I would like the
ability to format the spreadsheet on export. Is this something that I
can find help with here?

So it sounds like you want to export a table from access to excel?

Well in this post, I’m going to show you.

In this post we are going to avoid Excel reference complaints by using late binding.

First we’ll have a button which will call our export to Excel function, where we can put any parameters we need:

This data comes from the Northwind database’s “Customer” table. Click here to download.

Here is the code, commented to provide instruction:


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
Public Sub GenerateExcelList()

  

    'add a reference to ActiveX Data Objects 2.5 Library in Tools &gt; References

    Dim rst As ADODB.Recordset

   

   

    Dim strSQL As String

   

    'Dim objExcelBook As Excel.Workbook

    'Dim objExcelSheet As Excel.Worksheet

   

    'USING EARLY BINDING

    'Dim objExcelApp As Excel.Application

    'Dim objExcelBook As Excel.Workbook

    'Dim objExcelSheet As Excel.worksheet

   

    ''USING LATE BINDING

    Dim objExcelApp As Object

    Dim objExcelBook As Object

    Dim objExcelSheet As Object

   

    Dim varResultData As Variant

    Dim strFields() As String

    Dim i As Integer

    Dim intCounter As Integer

    Dim intCount As Integer

       

    Dim intRST_Fields As Integer

    Dim intRST_RecCount As Integer

    Dim intRST_StartRow As Integer

    Dim intRST_StartCol As Integer

   

    Dim intExcelRow As Integer

    Dim intExcelCol As Integer

   

    Dim strData As String

   

    Dim intRecCounter As Integer

    Dim strTemplate As String

   

    'TEMPLATE MUST BE SAVED AS TEMPLATE FOR CORRECT FUNCTIONALITY

    strTemplate = CurrentProject.Path &amp; "\report.xlsx"

   

    'Set m_objExcelApp = New Excel.Application

    On Error Resume Next

   

    strSheet = "Sheet1"



    DoCmd.Hourglass True

    '-------------------------------------------------------

    'STEP 1: EXPORT THE CHART DATA

    '-------------------------------------------------------

    strSQL = "SELECT * FROM Customers WHERE Country = 'Germany'"



    '-------------------------------------------------------------

    Set rst = New ADODB.Recordset

    rst.CursorLocation = adUseClient

    rst.CursorType = adOpenKeyset

    rst.Open strSQL, CurrentProject.Connection

   

   

    'don't do all the excel stuff if there is no data...

    If Not rst.EOF Then

       

        'this results in an error, not fatal so resume

        Set objExcelApp = GetObject(, "Excel.Application")

        If objExcelApp Is Nothing Then

            Set objExcelApp = CreateObject("Excel.Application")

        End If

   

        Set objExcelBook = objExcelApp.Workbooks.Add(strTemplate)

        Set objExcelSheet = objExcelBook.Worksheets(strSheet)

       

        intRST_Fields = rst.Fields.Count

        intRST_RecCount = rst.RecordCount

        intRST_StartRow = 1

        

        intRST_StartCol = 2

        

        'the recordset data is going to be stored in an array to reduce any object resource consumption

        varResultData = rst.GetRows

                

        intRecCounter = 0

        intExcelRow = 1

        intExcelCol = 1

   

        'make the excel application visible

        objExcelApp.Visible = True

        

        'print out all the fields from the recordset.

        'the spreadsheet is not zero based, but the recordset is zero based.

        For intFieldCount = 1 To rst.Fields.Count

            objExcelSheet.cells(intExcelRow, intFieldCount) = rst.Fields(intFieldCount - 1).Name

            objExcelSheet.cells(intExcelRow, intFieldCount).Font.Bold = 1

            objExcelSheet.cells(intExcelRow, intFieldCount).Font.Name = "Calibri"

            

            objExcelSheet.cells(intExcelRow, intFieldCount).interior.colorindex = 3

        Next

        

        'close the recordset because we don't need it anymore

        rst.Close

        Set rst = Nothing

        

        'now add the column data on the next row

        intExcelRow = intExcelRow + 1

        

        'the record set is zero based so if there are 11 rows, we loop from 0 to 10

        For intRecCounter = 0 To intRST_RecCount - 1

            For intRST_StartCol = 0 To intRST_Fields - 1

                'this is how we loop through the rows in our recordset (GetRows) array...

                objExcelSheet.cells(intExcelRow, intExcelCol) = varResultData(intRST_StartCol, intRecCounter)

                intExcelCol = intExcelCol + 1

            Next

            'next row, so increment the row destination and reset the column to start at

            intExcelRow = intExcelRow + 1

            intExcelCol = 1

        Next

   

        'CLOSE EXCEL REFERENCES:

        Set objExcelSheet = Nothing

        Set objExcelBook = Nothing

        'objExcelApp.Quit

        'Set objExcelApp = Nothing

       



        DoCmd.Hourglass False



    Else



       

      rst.Close

      Set rst = Nothing



     



    End If

End Sub