Wednesday, October 31, 2007

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!

1 comments:

Alexis on September 10, 2009 at 2:29 AM said...

For excel files advise-restore Excel.Because tool is free and helped me many times.Moreover it can work with critical data in Microsoft Excel format.

 

Get paid for your opinions! Click on the banner above to join Planet Pulse. Its totally free to sign up, and you can earn UNLIMITED. Find out more by visiting PLANET PULSE.
July Code Blog Copyright © 2010 Blogger Template Designed by Bie Blogger Template