Export Data From MS Access to Excel File

I passed data from MS Access to Excel recently, so I would like to share the techniques and code that I used. Firstly, a reference is needed to be made to Microsoft Excel. To add a reference, go to Tools -> References while working in any code module. As shown from the list, I am using Excel 11 (Office 2003). Look for the Microsoft Excel Object Library that is available on your computer and click the check box.


Here is my code from Access:

Public Function Export() As String
Dim oApp As Excel.Application
Dim oWB As Excel.Workbook
Dim i As Integer
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim sSQL As String

'Create an instance of Excel and add a new blank workbook
sSQL = "SELECT * FROM [table_name]"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)

Set oApp = New Excel.Application
oApp.Visible = False
Set oWB = oApp.Workbooks.Add

'Add the field names as column headers (optional)
For i = 0 To rst.Fields.Count - 1
oWB.Sheets(1).Cells(1, i + 1).Value = rst.Fields(i).Name
Next

oWB.Sheets(1).Range("1:1").Font.Bold = True
oWB.Sheets(1).Cells(2, 1).CopyFromRecordset rst

'Clean up ADO Objects
rst.Close
Set rst = Nothing

'Create a folder if not exist
Dim strFilePath As String
Dim strFolder As String
strFolder = "C:\NewFolder"
strFilePath = strFolder & "\Rpt_" & Format(Now(), "yyyymmdd_HHmmss") & ".xls"

Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(strFolder) Then
'Create the file
FileSystem.MkDir (strFolder)
End If

'Clean up Excel Objects
oWB.Close SaveChanges:=True, Filename:=strFilePath
Set oWB = Nothing
oApp.Quit
Set oApp = Nothing

'Open the file after export to excel
Shell "EXCEL.EXE """ & strFilePath & "", vbNormalFocus
End Function

HAPPY PROGRAMMING!