Integrating Access & Excel Programming Examples

Access provides a set of macro actions that you can use to transfer data to and from an Access database, an Excel worksheet, Word file, a text file or the different databases. Another option is to invoke these transfer actions through the DoCmd objects.

You use the TransferSpreadsheet and method to import or export data between the current Access database and a spreadsheet file. The syntax is:

expression.TransferSpreadsheet(TransferType, SpreadsheetType, TableName, FileName, HasFieldNames, Range)

expression is a variable that represents a DoCmd object.

Example:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "tbl_MaterialList","C:\MyList.xls", True, "A2:F200"

You use the TransferText method to import or export data between the current Access database and a text file, in either delimited or fixed-width format. TransferText method relies on import/export specification. The syntax is:

expression.TransferText(TransferType, SpecificationName, TableName, FileName, HasFieldNames, HTMLTableName, CodePage)

Example:
DoCmd.TransferText acExportDelim, "material_Import_Specification", _ "tbl_materialstatus", "D:\material_status.csv", True

Go To Top

Import Data from All EXCEL Files in a Single Folder via TransferSpreadsheet

Generic code to import the data from the first (or only) worksheet in all EXCEL files that are located within a single folder. All of the EXCEL files' worksheets must have the data in the same layout and format.

Dim strPathFile As String, strFile As String, strPath As String, strTable As String
Dim blnHasFieldNames As Boolean

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

' Replace C:\Documents\ with the real path to the folder that contains the EXCEL files
strPath = "C:\Documents\"

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

strFile = Dir(strPath & "*.xls")
Do While Len(strFile) > 0
      strPathFile = strPath & strFile
      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

      strFile = Dir()
Loop

Go To Top

Import Data from Specific Worksheets in All EXCEL Files in a Single Folder via TransferSpreadsheet

Generic code to import the data from specific worksheets in all EXCEL files (worksheet names are the same in all files) that are located within a single folder. All of the EXCEL files' worksheets with the same worksheet names must have the data in the same layout and format.

Dim strPathFile As String, strFile As String, strPath As String
Dim blnHasFieldNames As Boolean
Dim intWorksheets As Integer

' Replace 3 with the number of worksheets to be imported from each EXCEL file
Dim strWorksheets(1 To 3) As String

' Replace 3 with the number of worksheets to be imported from each EXCEL file (this code assumes that each worksheet with the same name is being imported into a separate table for that specific worksheet name)
Dim strTables(1 To 3) As String

' Replace generic worksheet names with the real worksheet names;
' Add / delete code lines so that there is one code line for each worksheet that is to be imported from each workbook file.
strWorksheets(1) = "WorksheetName1"
strWorksheets(2) = "WorksheetName2"
strWorksheets(3) = "WorksheetName3"

' Replace generic table names with the real table names
strTables(1) = "TableName1"
strTables(2) = "TableName2"
strTables(3) = "TableName3"

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

' Replace C:\Documents\ with the real path to the folder that contains the EXCEL files
strPath = "C:\Documents\"

' Replace 3 with the number of worksheets to be imported from each EXCEL file
For intWorksheets = 1 To 3

      strFile = Dir(strPath & "*.xls")
      Do While Len(strFile) > 0
            strPathFile = strPath & strFile
            DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTables(intWorksheets), _
                  strPathFile, blnHasFieldNames, strWorksheets(intWorksheets) & "$"
            strFile = Dir()
      Loop

Next intWorksheets

Go To Top

Import Data from All Worksheets in a Single EXCEL Workbook into One Table via TransferSpreadsheet

Generic code to import the data from all worksheets in a single EXCEL file. Because all of the worksheets' data will be imported into the same table, all of the EXCEL files' worksheets must have the data in the same layout and format.

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile as String, strTable as String
Dim strPassword As String

' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
      Set objExcel = CreateObject("Excel.Application")
      blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

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

' Replace C:\Filename.xls with the actual path and filename
strPathFile = "C:\Filename.xls"

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

' Replace passwordtext with the real password;
' if there is no password, replace it with vbNullString constant (e.g., strPassword = vbNullString)
strPassword = "passwordtext"

blnReadOnly = True   ' open EXCEL file in read-only mode

' Open the EXCEL file and read the worksheet names into a collection
Set colWorksheets = New Collection
Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
      colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into the table
For lngCount = colWorksheets.Count To 1 Step -1
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
            strTable, strPathFile, blnHasFieldNames, colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

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

Go To Top

Import Data from All Worksheets in a Single EXCEL Workbook into Separate Tables via TransferSpreadsheet

Generic code to import the data from all worksheets in a single EXCEL workbook. Each worksheet's data will be imported into a separate table whose name is 'tbl' plus the worksheet name (e.g., "tblSheet1").

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String
Dim strPassword As String

' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
      Set objExcel = CreateObject("Excel.Application")
      blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

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

' Replace C:\Filename.xls with the actual path and filename
strPathFile = "C:\Filename.xls"

' Replace passwordtext with the real password;
' if there is no password, replace it with vbNullString constant (e.g., strPassword = vbNullString)
strPassword = "passwordtext"

blnReadOnly = True     ' open EXCEL file in read-only mode

' Open the EXCEL file and read the worksheet names into a collection
Set colWorksheets = New Collection
Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
      colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
            "tbl" & colWorksheets(lngCount), strPathFile, blnHasFieldNames, colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

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

Go To Top

Import Data from A Specific Worksheet in All EXCEL Files in a Single Folder into Separate Tables via TransferSpreadsheet

Generic code to import the data from a specific worksheet in all EXCEL files in a single folder. Each worksheet's data will be imported into a separate table whose name is 'tbl_' plus the workbook name without the ".xls" file extension (e.g., "tbl_NameOfFile").

Dim blnHasFieldNames as Boolean
Dim strWorksheet As String, strTable As String
Dim strPath As String, strPathFile As String

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

' Replace C:\Documents\ with the real path to the folder that contains the EXCEL files
strPath = "C:\Documents\"

' Replace worksheetname with the real name of the worksheet that is to be imported from each file
strWorksheet = "worksheetname"

' Import the data from each workbook file in the folder
strFile = Dir(strPath & "*.xls")
Do While Len(strFile) > 0
      strPathFile = strPath & strFile
      strTable = "tbl_" & Left(strFile, InStrRev(strFile, ".xls") - 1)

      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTable, strPathFile, _
            blnHasFieldNames, strWorksheet & "$"

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

      strFile = Dir()
Loop

Go To Top

Browse to a Single EXCEL File and Import Data from that EXCEL File via TransferSpreadsheet

Generic code to browse to a single EXCEL file, and then to import the data from the first (or only) worksheet in that EXCEL file. This generic method uses the Windows API to browse to a single file the code for this API (was written by Getz).

First step is to paste all the Getz's code into a new module in your database. Be sure to give the module a unique name (i.e., it cannot have the same name as any other module, any other function, or any other subroutine in the database). Then use this generic code to allow the user to select the EXCEL file that is to be imported.

Dim strPathFile As String
Dim strTable As String, strBrowseMsg As String
Dim strFilter 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:"

strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")
strPathFile = ahtCommonFileOpenSave(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

Go To Top

Browse to a Single Folder and Import Data from All EXCEL Files in that Folder via TransferSpreadsheet

Generic code to browse to a single folder, and then to import the data from the first (or only) worksheet in all EXCEL files that are located within that folder. All of the EXCEL files' worksheets must have the data in the same layout and format. This generic method uses the Windows API to browse to a single folder; the code for this API (was written by Terry Kreft).

First step is to paste all the Kreft's code into a new module in your database. Be sure to give the module a unique name (i.e., it cannot have the same name as any other module, any other function, or any other subroutine in the database). Then use this generic code to allow the user to select the folder in which the EXCEL files are located.

Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String, strBrowseMsg 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 folder that contains the EXCEL files:"
strPath = BrowseFolder(strBrowseMsg)

If strPath = "" Then
      MsgBox "No folder 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"

strFile = Dir(strPath & "\*.xls")
Do While Len(strFile) > 0
      strPathFile = strPath & strFile
      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

      strFile = Dir()
Loop

Go To Top

Integrating calculation & values input between Access Table and Excel Worksheet

Let's say you have multiple values in an Access table, and you want to input them into a calculation model in Excel sheet and then store the calculated result back to Access table. Normally this is time-consuming, but by this VBA example or by some code modification, you can do it rather easily.

In the Access table there are 3 fields: Sales, SalesRep and Contribution. For every record value in the Sales field and SalesRep field of the Access table (called tbl_ContributionModel), the code puts them in two cells in the Excel worksheet (B5 and B5 in Sheet1) to calculate a Contribution profit number. The code then take the resulting Contribution number, one by one after each computation, and stores the result back into the table. You can use this code to suit your situation by changing file's path, cell ranges, names of the sheet, table and fields.

Download the 2 files, store them under the directory C:\Sales\
Remember also to reference to Microsoft Excel 11.0 Object Library.

Sub IntegratingExcelAccess()
     Dim xlApp As Excel.Application
     Dim Wb As Excel.Workbook
     Dim Ws As Excel.Worksheet
     Dim rs As ADODB.Recordset

     Set xlApp = New Excel.Application
     xlApp.Visible = True
     Set Wb = xlApp.Workbooks.Open("C:\Sales\ContributionModel.xls")
     Set Ws = Wb.Sheets("Sheet1")

     Set rs = New ADODB.Recordset
     rs.Open "tbl_ContributionModel", CurrentProject.Connection, adOpenDynamic, adLockOptimistic

     rs.MoveFirst
     While Not rs.EOF
            Ws.Range("B9").Value = rs.Fields("Sales").Value
            Ws.Range("B5").Value = rs.Fields("SalesRep").Value
            rs.Fields("Contribution").Value = Ws.Range("B17").Value
          rs.MoveNext
     Wend

rs.Close
Wb.Close False

Set Ws = Nothing
Set Wb = Nothing
xlApp.Quit
Set xlApp = Nothing
Set rs = Nothing
End Sub

Go To Top

Integrating Access Queries update to put data in Excel file which refreshes the charts

There are 2 charts in Excel worksheet that need data update from Access Queries. It is easier to build a worksheet like this thru the Excel GUI and modify the data from Visual Basic code. In below example, you first have to obtain your sales data after every month end in order to run the 2 queries. It is easy to only open up the workbook (instead of using Add method) using CopyFromRecordset method to input the data into the workbook. The template workbook will be preserved, instead the code uses the SaveAs method to save the workbook under another name. You can use this code to suit your situation by changing file's path, cell range, names of the sheets and queries.

Download the 2 files, store them under the directory C:\Sales\
Remember also to reference to Microsoft Excel 11.0 Object Library.

Sub AccessToUpdateExcelData()
      Dim xlApp As Excel.Application
      Dim Wb As Excel.Workbook
      Dim Ws As Excel.Worksheet
      Dim Rng As Excel.Range
      Dim rs As ADODB.Recordset
      Dim xlFile As String
      Dim xlSaveFile As String

      xlFile = "C:\Sales\MonthlySalesTemplate.xls"
      xlSaveFile = "C:\Sales\MonthlySalesCharts.xls" ' save as a new file name to preserve template workbook

      Set xlApp = New Excel.Application
      xlApp.Visible = True
      Set Wb = xlApp.Workbooks.Open(xlFile)
      Set Ws = Wb.Sheets("Sheet1")

      Set rs = New ADODB.Recordset
      rs.Open "select * from qry_SalesByWeek", CurrentProject.Connection
      Set Rng = Ws.Range("A5")
      Rng.CopyFromRecordset rs
      rs.Close

      rs.Open "select * from qry_SalesByBranch", CurrentProject.Connection
      Set Rng = Ws.Range("A19")
      Rng.CopyFromRecordset rs
      rs.Close
      Set rs = Nothing

      Wb.SaveAs xlSaveFile    ' save as a new file name
      Wb.Close

      Set Rng = Nothing
      Set Ws = Nothing
      Set Wb = Nothing
      xlApp.Quit
      Set xlApp = Nothing
End Sub

Go To Top

Read Data from EXCEL File via Query (SQL Statement)

Generic SQL statement that reads data from an EXCEL file. Replace C:\MyFolder\MyFile.xls with the real path and filename of the EXCEL file. Replace WorksheetName with the real name of the worksheet -- NOTE that the name cannot be longer than 30 characters (one less than EXCEL's limit for a worksheet name) or else ACCESS / Jet will give you an error stating that the file cannot be found. In this SQL statement, HDR=YES means that the first row of data are header names (change to NO if the first row does not contain header names); IMEX=1 alllows "mixed formatting" within a column (alpha characters and numbers, for example) so that errors will not be raised when importing mixed formats; the $ character must be immediately after the worksheet name; and A2:U66536 is the range of data to be imported (these cell references can be changed to any contiguous range of cells in the worksheet).

SELECT T1.*, 1 AS SheetSource
FROM [Excel 8.0;HDR=YES;IMEX=1;Database=C:\MyFolder\MyFile.xls].[WorksheetName$A2:U65536] as T1;

Go To Top

Write Data From an EXCEL Worksheet into a Recordset using Automation (VBA)

Generic code to open a recordset (based on an existing table) for the data that are to be imported from a worksheet in an EXCEL file, and then to loop through the recordset and write each cell's value into a field in the recordset, with each row in the worksheet being written into a separate record. The starting cell for the EXCEL worksheet is specified in the code; after that, the data are read from contiguous cells and rows. This code example uses "late binding" for the EXCEL automation, and this code assumes that the EXCEL worksheet DOES NOT contain header information in the first row of data being read.

Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim blnEXCEL As Boolean

blnEXCEL = False

' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
      Set xlx = CreateObject("Excel.Application")
      blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

' Change True to False if you do not want the workbook to be visible when the code is running
xlx.Visible = True

' Replace C:\Filename.xls with the actual path and filename of the EXCEL file from which you will read the data
Set xlw = xlx.Workbooks.Open("C:\Filename.xls", , True)      ' opens in read-only mode

' Replace WorksheetName with the actual name of the worksheet in the EXCEL file
Set xls = xlw.Worksheets("WorksheetName")

' Replace A1 with the cell reference from which the first data value (non-header information) is to be read
Set xlc = xls.Range("A1")     ' this is the first cell that contains data

Set dbs = CurrentDb()

' Replace QueryOrTableName with the real name of the table or query that is to receive the data from the worksheet
Set rst = dbs.OpenRecordset("QueryOrTableName", dbOpenDynaset, dbAppendOnly)

' write data to the recordset
Do While xlc.Value <> ""
      rst.AddNew
            For lngColumn = 0 To rst.Fields.Count - 1
                  rst.Fields(lngColumn).Value = xlc.Offset(0, lngColumn).Value
            Next lngColumn
      rst.Update
      Set xlc = xlc.Offset(1,0)
Loop

rst.Close
Set rst = Nothing

dbs.Close
Set dbs = Nothing

' Close the EXCEL file without saving the file, and clean up the EXCEL objects
Set xlc = Nothing
Set xls = Nothing
xlw.Close False
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing

Go To Top

Avoid DataType Mismatch Errors when Importing Data from an EXCEL File or when Linking to an EXCEL File

When importing data from an EXCEL spreadsheet into an ACCESS table via the TransferSpreadsheet action, or when linking to an EXCEL spreadsheet as a linked ACCESS table, often you will see the "#Num!" error code for the value in a field in the ACCESS table; or you will see that leading zeroes are lost from text strings that contain only number characters; or you will see that text strings longer than 255 characters are truncated in a field in the ACCESS table.

The "#Num!" error code that you see is because Jet (ACCESS) sees only numeric values in the first 8 - 25 rows of data in the EXCEL sheet, even though you have formatted the EXCEL column as "Text". In EXCEL, if you change the format from "General" or a numeric format to "Text", the previous numeric format for a cell will "stick" to numeric values.

What ACCESS and Jet are doing is assuming that the "text" data actually are numeric data, and thus all your non-numeric text strings are "not matching" to a numeric data type. One of these suggestions should fix the problem:

1) Insert a ' (apostrophe) character at the beginning of each cell's value for that column in the EXCEL file -- that should let Jet (ACCESS) treat that column's values as text and not numeric.

2) Insert a dummy row of data as the first row, where the dummy row contains nonnumeric characters in the cell in that column -- that should let Jet (ACCESS) treat that column's values as text and not numeric.

3) Double-click into the EXCEL cell that has the "numeric" data, then click on any other cell -- that will "update" the cell to the "Text" format.

4) Create a blank table into which you will import the spreadsheet's data. For the field that will receive the numeric data, make its data type "Text". Jet (ACCESS) then will "honor" the field's datatype when it does the import.

The loss of leading zeroes from text strings that contain only number characters is a symptom of the same problem noted above for the "#Num!" error code. One of the these suggestions should fix the problem:

1) Insert a ' (apostrophe) character at the beginning of each cell's value for that column in the EXCEL file -- that should let Jet (ACCESS) treat that column's values as text and not numeric.

2) Insert a dummy row of data as the first row, where the dummy row contains nonnumeric characters in the cell in that column -- that should let Jet (ACCESS) treat that column's values as text and not numeric.

3) Create a blank table into which you will import the spreadsheet's data. For the field that will receive the numeric data, make its data type "Text". Jet (ACCESS) then will "honor" the field's datatype when it does the import.

The truncated text string that you see is because Jet (ACCESS) sees only "short text" (text strings no longer than 255 characters) values in the first 8 - 25 rows of data in the EXCEL sheet, even though you have longer text farther down the rows. What ACCESS and Jet are doing is assuming that the "text" data actually are Text data type, not Memo data type. One of these suggestions should fix the problem:

1) Insert a dummy row of data as the first row, where the dummy row contains a text string longer than 255 characters in the cell in that column -- that should let Jet (ACCESS) treat that column's values as memo and not text.

2) Create a blank table into which you will import the spreadsheet's data. For the field that will receive the "memo" data, make its data type "Memo". Jet (ACCESS) then will "honor" the field's datatype when it does the import.

It's possible to force Jet to scan all the rows and not guess the data type based on just the first few rows. See this article for information about the registry key (see TypeGuessRows and MaxScanRows information). There are some reports by others that this registry key may not work as expected when using Windows XP SP3 or when using ACCESS 2007.

Go To Top

Create and Export a Parameter Query to EXCEL file via TransferSpreadsheet

Generic code to generate "on the fly" a query that uses one or more controls on an open form as parameters, and then export that query to an EXCEL file. This example concatenates the parameter values into the generated SQL statement and then saves the query so that it can be exported. The query then is deleted after the export is completed.

Dim dbs As DAO.Database
Dim qdfTemp As DAO.QueryDef
Dim strSQL As String, strQDF As String
Set dbs = CurrentDb

' Replace NameOfTableOrQuery with the real name of the table or query, replace NameOfForm with the
' real name of the form, and replace ADateControlOnForm and AnotherDateControlOnForm with the real
' names of the controls on that form
strSQL = "SELECT NameOfTableOrQuery.* FROM NameOfTableOrQuery " & _
      "WHERE NameOfTableOrQuery.FieldName >= " & _
      Format(Forms!NameOfForm!ADateControlOnForm.Value,"\#mm\/dd\/yyyy\#") & _
      " And NameOfTableOrQuery.FieldName <=" & _
      Format(Forms!NameOfForm!AnotherDateControlOnForm.Value,"\#mm\/dd\/yyyy\#") & "';"

strQDF = "_TempQuery_"
Set qdfTemp = dbs.CreateQueryDef(strQDF, strSQL)
qdfTemp.Close
Set qdfTemp = Nothing

' Replace C:\MyFolderName\MyFileName.xls with the real path and filename for the EXCEL file that is to contain the exported data
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strQDF,"C:\MyFolderName\MyFileName.xls"

dbs.QueryDefs.Delete strQDF
dbs.Close
Set dbs = Nothing

Go To Top

Create a Query and Export multiple "filtered" versions of a Query (based on data in another table) to separate EXCEL files via TransferSpreadsheet (DAO method)

Generic code to create a temporary query, get list of filtering values, and then loop through the list to filter various data and export each filtered query to separate EXCEL files. In this sample code, the employees assigned to each manager are exported to separate EXCEL files, one file for each manager.

Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstMgr As DAO.Recordset
Dim strSQL As String, strTemp As String, strMgr As String

Const strQName As String = "zExportQuery"

Set dbs = CurrentDb

' Create temporary query that will be used for exporting data; we give it a dummy SQL statement initially
' (this name will be changed by the code to conform to each manager's identification)
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName

' Code to set strSQL needs to be changed to conform to your database design -- ManagerID and EmployeesTable
' need to be changed to your table and field names. Get list of ManagerID values -- note: replace my generic table
' and field names ' with the real names of the EmployeesTable table and the ManagerID field
strSQL = "SELECT DISTINCT ManagerID FROM EmployeesTable;"
Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)

' Now loop through list of ManagerID values and create a query for each ManagerID so that the data can be
' exported -- the code assumes that the actual names of the managers are in a lookup table -- again, replace
' generic names with real names of tables and fields
If rstMgr.EOF = False And rstMgr.BOF = False Then
rstMgr.MoveFirst
Do While rstMgr.EOF = False

' Code to set strMgr needs to be changed to conform to your database design -- ManagerNameField, ManagersTable,
' and ManagerID need to be changed to your table and field names to be changed to your table and field names
strMgr = DLookup("ManagerNameField", "ManagersTable", _
"ManagerID = " & rstMgr!ManagerID.Value)

' Code to set strSQL needs to be changed to conform to your database design -- ManagerID and EmployeesTable
' need to be changed to your table and field names.
            strSQL = "SELECT * FROM EmployeesTable WHERE " & _
                  "ManagerID = " & rstMgr!ManagerID.Value & ";"
            Set qdf = dbs.QueryDefs(strTemp)
            qdf.Name = "q_" & strMgr
            strTemp = qdf.Name
            qdf.SQL = strSQL
            qdf.Close
            Set qdf = Nothing

' Replace C:\FolderName\ with actual path
            DoCmd.TranferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
                  strTemp, "C:\FolderName\" & strMgr & Format(Now(), _
                  "ddMMMyyy_hhnn") & ".xls"
            rstMgr.MoveNext
      Loop
End If

rstMgr.Close
Set rstMgr = Nothing

dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing

Go To Top

Create a Query and Export multiple "filtered" versions of a Query (based on data in another table) to separate Worksheets within one EXCEL file via TransferSpreadsheet

Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstMgr As DAO.Recordset
Dim strSQL As String, strTemp As String, strMgr As String

' Replace PutEXCELFileNameHereWithoutdotxls with actual EXCEL filename without the .xls extension
' (for example, MyEXCELFileName, BUT NOT MyEXCELFileName.xls)
Const strFileName As String = "PutEXCELFileNameHereWithoutdotxls"
Const strQName As String = "zExportQuery"

Set dbs = CurrentDb

' Create temporary query that will be used for exporting data; we give it a dummy SQL statement
' initially (this name will be changed by the code to conform to each manager's identification)
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName

' Code to set strSQL needs to be changed to conform to your database design -- ManagerID and
' EmployeesTable need to be changed to your table and field names. Get list of ManagerID
' values -- note: replace my generic table and field names with the real names of the EmployeesTable
' table and the ManagerID field
strSQL = "SELECT DISTINCT ManagerID FROM EmployeesTable;"
Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)

' Now loop through list of ManagerID values and create a query for each ManagerID so that the data can
' be exported -- the code assumes that the actual names of the managers are in a lookup table -- again,
' replace generic names with real names of tables and fields
If rstMgr.EOF = False And rstMgr.BOF = False Then
rstMgr.MoveFirst
Do While rstMgr.EOF = False

' Code to set strMgr needs to be changed to conform to your database design -- ManagerNameField,
' ManagersTable, and ManagerID need to be changed to your table and field names be changed to
' your table and field names
strMgr = DLookup("ManagerNameField", "ManagersTable", _
"ManagerID = " & rstMgr!ManagerID.Value)

' Code to set strSQL needs to be changed to conform to your database design -- ManagerID,
' EmployeesTable need to be changed to your table and field names
            strSQL = "SELECT * FROM EmployeesTable WHERE " & _
                  "ManagerID = " & rstMgr!ManagerID.Value & ";"
            Set qdf = dbs.QueryDefs(strTemp)
            qdf.Name = "q_" & strMgr
            strTemp = qdf.Name
            qdf.SQL = strSQL
            qdf.Close
            Set qdf = Nothing

' Replace C:\FolderName\ with actual path
            DoCmd.TranferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
                  strTemp, "C:\FolderName\" & strFileName & ".xls"
            rstMgr.MoveNext
      Loop
End If

rstMgr.Close
Set rstMgr = Nothing

dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing

Go To Top

Write Data From a Recordset into an EXCEL Worksheet using Automation

Generic code to open a recordset for the data that are to be written into a worksheet in an EXCEL file (for this example, the EXCEL file must already exist, and the worksheet must already exist in the EXCEL file), and then to loop through the recordset and write each field's value into a cell in the worksheet, with each record being written into a separate row in the worksheet. The starting cell for the EXCEL worksheet is specified in the code; after that, the data are written into contiguous cells and rows. This code example uses "late binding" for the EXCEL automation.

Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim blnEXCEL As Boolean, blnHeaderRow As Boolean

blnEXCEL = False

' Replace True with False if you do not want the first row of the worksheet to be a header
' row (the names of the fields from the recordset)
blnHeaderRow = True

' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlx = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

' Change True to False if you do not want the workbook to be visible when the code is running
xlx.Visible = True

' Replace C:\Filename.xls with the actual path and filename of the EXCEL file into which you will write the data
Set xlw = xlx.Workbooks.Open("C:\Filename.xls")

' Replace WorksheetName with the actual name of the worksheet in the EXCEL file
' (note that the worksheet must already be in the EXCEL file).
Set xls = xlw.Worksheets("WorksheetName")

' Replace A1 with the cell reference into which the first data value is to be written
Set xlc = xls.Range("A1") ' this is the first cell into which data go

Set dbs = CurrentDb()

' Replace QueryOrTableName with the real name of the table or query whose data are to be written into the worksheet
Set rst = dbs.OpenRecordset("QueryOrTableName", dbOpenDynaset, dbReadOnly)

If rst.EOF = False And rst.BOF = False Then

      rst.MoveFirst

      If blnHeaderRow = True Then
            For lngColumn = 0 To rst.Fields.Count - 1
                  xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
            Next lngColumn
            Set xlc = xlc.Offset(1,0)
      End If

      ' write data to worksheet
      Do While rst.EOF = False
            For lngColumn = 0 To rst.Fields.Count - 1
                  xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
            Next lngColumn
            rst.MoveNext
            Set xlc = xlc.Offset(1,0)
      Loop

End If

rst.Close
Set rst = Nothing

dbs.Close
Set dbs = Nothing

' Close the EXCEL file while saving the file, and clean up the EXCEL objects
Set xlc = Nothing
Set xls = Nothing
xlw.Close True ' close the EXCEL file and save the new data
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing

Go To Top

Write Data From a Recordset into an EXCEL Worksheet using EXCEL's CopyFromRecordset

Generic code to open a recordset for the data that are to be written into a worksheet in an EXCEL file (for this example, the EXCEL file does not already exist), and then to use EXCEL's CopyFromRecordset method to copy the data from the recordset into the first worksheet in that EXCEL file, with each record being written into a separate row in the worksheet. The code allows for a header row to be created in the worksheet if this is desired. This code example uses "late binding" for the EXCEL automation.

Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strPathFileName As String, strWorksheetName As String
Dim strRecordsetDataSource As String
Dim blnEXCEL As Boolean, blnHeaderRow As Boolean

blnEXCEL = False

' Replace C:\Filename.xls with the actual path and filename that will be used to save the
' new EXCEL file into which you will write the data
strPathFileName = "C:\Filename.xls"

' Replace QueryOrTableName with the real name of the table or query whose data are to be written into the worksheet
strRecordsetDataSource = "QueryOrTableName"

' Replace True with False if you do not want the first row of the worksheet to be a header
' row (the names of the fields from the recordset)
blnHeaderRow = True

' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
      Set xlx = CreateObject("Excel.Application")
      blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

' Change True to False if you do not want the workbook to be visible when the code is running
xlx.Visible = True

' Create a new EXCEL workbook
Set xlw = xlx.Workbooks.Add

' Rename the first worksheet in the EXCEL file to be the first 31characters of the string in
' the strRecordsetDataSource variable
Set xls = xlw.Worksheets(1)
xls.Name = Trim(Left(strRecordsetDataSource, 31))

' Replace A1 with the cell reference of the first cell into which the headers will be written
' (blnHeaderRow = True), or into which the data values will be written (blnHeaderRow = False)
Set xlc = xls.Range("A1")

Set dbs = CurrentDb()

Set rst = dbs.OpenRecordset(strRecordsetDataSource, dbOpenDynaset, dbReadOnly)

If rst.EOF = False And rst.BOF = False Then
      ' Write the header row to worksheet
      If blnHeaderRow = True Then
            For lngColumn = 0 To rst.Fields.Count - 1
                  xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
            Next lngColumn
            Set xlc = xlc.Offset(1,0)
      End If

      ' copy the recordset's data to worksheet
      xlc.CopyFromRecordset rst
End If

rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing

' Save and close the EXCEL file, and clean up the EXCEL objects
Set xlc = Nothing
Set xls = Nothing
xlw.SaveAs strPathFileName
xlw.Close False
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing

Go To Top

Browse to a single EXCEL File and Export Data to that EXCEL File via TransferSpreadsheet

Generic code to browse to a single EXCEL file, and then to export the data to that EXCEL file. This generic method uses the Windows API to browse to a single file the code for this API (was written by Ken Getz).

First step is to paste all the Getz's code into a new module in your database. Be sure to give the module a unique name (i.e., it cannot have the same name as any other module, any other function, or any other subroutine in the database). Then use this generic code to allow the user to select the EXCEL file to which the data are to be exported.

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

strBrowseMsg = "Select the EXCEL file:"

strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)", "*.xls")
strPathFile = ahtCommonFileOpenSave( _
      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 from which the data are to be exported
strTable = "tablename"

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
      strTable, strPathFile

Go To Top

Browse to a single Folder and Export Data to a New EXCEL File in that Folder via TransferSpreadsheet

Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String, strBrowseMsg As String
Dim blnHasFieldNames As Boolean

strBrowseMsg = "Select the folder where the new EXCEL file will be created:"
strPath = BrowseFolder(strBrowseMsg)

If strPath = "" Then
MsgBox "No folder was selected.", vbOK, "No Selection"
Exit Sub
End If

' Replace filename.xls with the real name of the EXCEL file that is to be created and into which the data are to be exported.
strFile = "filename.xls"

' Replace tablename with the real name of the table from which the data are to be exported.
strTable = "tablename"

strPathFile = strPath & "\" & strFile

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strTable, strPathFile

Go To Top

Exporting Access table as a text-delimited file (FSO method)

The 2 example below demonstrate the use of FSO and DoCmd objects to export Access table as a text-delimited file.
You need to reference Micro`soft Scripting Runtime library in order to run the FileSystemObject (FSO) and its related objects. FSO provides a simpler way for us to deal with text-oriented data.

Dim fso As FileSystemObject
Set fso = New FileSystemObject

' delete output file if it already exists
If fso.FileExists("D:\MyData\material_status.csv") Then
    fso.DeleteFile "D:\MyData\material_status.csv"
End If

On Error Resume Next
DoCmd.TransferText acExportDelim, "material_Import_Specification", _
   "tbl_materialstatus", "D:\MyData\material_status.csv", True
If Err.Number <> 0 Then
    MsgBox "An Error occured during the transfer (" & Err.Description & ")"
End If

On Error GoTo 0 ' resume normal error handling

Go To Top

For this second example, you need to reference both Microsoft Scripting Runtime library (to run FSO and its related objects), and Microsoft ActiveX Data Objects 2.x Library. Its purpose is to use FSO and ADO objects to export Access table as a text-delimited file.

Dim fso As FileSystemObject
Dim txt As TextStream
Dim rs As ADODB.Recordset
Dim str As String

Set fso = New FileSystemObject   ' new FSO object to create TextStream file for writing data to external disk file
Set txt = fso.CreateTextFile("D:\MyData\material_stockstatus.txt", True)
Set rs = New ADODB.Recordset

rs.ActiveConnection = CurrentProject.Connection
rs.Open "Select [PartNumber], [StandardCost], [QtyOnHand] From tbl_MaterialList", , _
   adOpenForwardOnly, adLockReadOnly

txt.WriteLine "PartNumber, StandardCost, QtyOnHand" ' TextStream's WriteLIne to write column headers

Do While Not rs.EOF
     str = rs("PartNumber") & " "
     str = str & FormatCurrency(rs("StandardCost"), , vbUseDefault) & " "
     str = str & FormatNumber(rs("QtyOnHand"), 0, vbTrue, vbFalse, vbUseDefault)
     txt.WriteLine str ' TextStream's WriteLIne to output selected columns data to the text file
     rs.MoveNext
Loop

' clean up objects
rs.Close
txt.Close

Go To Top

Importing a Text File to populate an Access Table (FSO method)

Dim fso As FileSystemObject
Dim txt As TextStream
Dim rs As ADODB.Recordset
Dim Fields() As String, Table As String, Types() As String
Dim s As String, x() As String
Dim i As Integer

Set fso = New FileSystemObject
Set txt = fso.OpenTextFile("D:\AccessData\material_stockstatus.txt", ForReading, False)

' get table name
Table = txt.ReadLine

Set rs = New ADODB.Recordset
rs.ActiveConnection = CurrentProject.Connection
rs.Open "[tbl_weekly_materialstatus]", , adOpenDynamic, adLockOptimistic

' get field names
s = txt.ReadLine
x = Split(s, ",")
ReDim Fields(UBound(x))

For i = 0 To UBound(x)
     Fields(i) = GetString(x(i))
Next i

' get field types
s = txt.ReadLine
x = Split(s, ",")
ReDim Types(UBound(x))

For i = 0 To UBound(x)
     Types(i) = GetString(x(i))
Next i

' load data
Do While Not txt.AtEndOfStream
s = txt.ReadLine
x = Split(s, ",")
rs.AddNew

For i = 0 To UBound(Fields)
     Select Case Types(i)
           Case "PartNumber"
                  rs.Fields(Fields(i)) = GetDate(x(i))
           Case "ReleaseDate"
                  rs.Fields(Fields(i)) = GetDouble(x(i))
           Case "StandardCost"
                  rs.Fields(Fields(i)) = GetString(x(i))
           Case "QtyOnHand"
                  rs.Fields(Fields(i)) = GetString(x(i))
    End Select
Next i

rs.Update
Loop

rs.Close
txt.Close

Go To Top

This site was created in February 2007
by William Tan