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 > 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 & "\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
Here is the end result:
#access-vba-export-table-to-excel-xlsx
Let me know if you have questions.






