Exporting Data from Access to Excel
There are several techniques you can use to export data from Access tables or queries to Excel. Some of them (the OutputTo and TransferSpreadsheet methods) export all the data from an Access table or query to an Excel worksheet. You can also use Automation code to create a worksheet, and then format it. The following sections show how to export data from Access to Excel, using a variety of methods.
MultiSelect Listbox Form
To allow selection of records from an Access data source, I created a form with a MultiSelect listbox to use for selecting records on an ad hoc basis. The form header has two comboboxes, for selecting a data source and export type. The Select Data Source combobox has as its row source the table tlkpDataSources, with a DataType field describing the type of data, and a DataSource field, with the name of a query. The Select Export Type combobox has tlkpExportTypes as its row source, with an AutoNumber ExportID field, and ExportType and FileType fields. The combobox displays a concatenated expression combining ExportType and FileType, and the ExportID numeric value is used in a Select Case statement for calling the appropriate Sub procedure to do the export.
When you select a data source from cboSelectDataSource, an AfterUpdate event procedure assigns the appropriate record source to the MultiSelect listbox on the form and formats its columns appropriately. The data source value is saved to a public variable (pstrDataSource), so it can be used in other code, even if the combobox has been cleared.
Private Sub cboSelectDataSource_AfterUpdate() On Error GoTo ErrorHandler Set lst = Me![lstSelectMultiple] pstrDataSource = Me![cboSelectDataSource].Column(1) lst.RowSource = pstrDataSource Select Case pstrDataSource Case "qryContacts" lst.ColumnCount = 13 lst.ColumnWidths = "0 in;1.25 in;1.25 in;1 in;.6 in;.6 in;0 in;0 in;0 in;0 in;0 in;0 in;0 in" Case "qryEBooksAndAuthors" lst.ColumnCount = 7 lst.ColumnWidths = "0 in;1.5 in;1.5 in;1.5 in;1.5 in;1.25 in;1.25 in" Case "qryEmployeePhones" lst.ColumnCount = 4 lst.ColumnWidths = "1.5 in;1 in;1.5 in;1.5 in" End Select ErrorHandlerExit: Exit Sub ErrorHandler: MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description Resume ErrorHandlerExit End Sub
You can select one or more records in the listbox by Ctrl-clicking to select noncontiguous records, or Shift-clicking to select a range of rows (as with the Windows Explorer). The Select All button lets you quickly select all the records. Figure 13.7 shows the listbox form, with several records selected for export.
Figure 13.7
After making your selections, selecting an export type sets several public variables.
Private Sub cboSelectExportType_AfterUpdate() On Error GoTo ErrorHandler pstrExportType = Nz(Me![cboSelectExportType].Column(2)) pstrFileType = Nz(Me![cboSelectExportType].Column(3)) plngExportType = Nz(Me![cboSelectExportType].Column(0)) ErrorHandlerExit: Exit Sub ErrorHandler: MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description Resume ErrorHandlerExit End Sub
Finally, clicking the Export Data command button runs a Click event procedure that checks that a data source, export type, and at least one record have been selected, and then runs the appropriate Sub procedure to do the export. This procedure is listed below, with explanatory text.
Private Sub cmdExportData_Click() On Error GoTo ErrorHandler Dim cbo As Access.ComboBox Dim lngNoFields As Long Dim varItem As Variant Dim strSQL As String Dim dbs As DAO.Database Dim rst As DAO.Recordset Dim dflds As DAO.Fields Dim i As Integer Dim strTable As String
Check that a data source has been selected, and exit if not.
Set cbo = Me![cboSelectDataSource] pstrDataSource = Nz(cbo.Column(1)) If pstrDataSource = "" Then MsgBox "Please select a data source." cbo.SetFocus cbo.Dropdown GoTo ErrorHandlerExit End If
Check that an export type and file type have been selected, and exit if not.
If plngExportType = 0 Then MsgBox "Please select an export type" Me![cboSelectExportType].SetFocus Me![cboSelectExportType].Dropdown GoTo ErrorHandlerExit End If
Print the data source and export type values to the Immediate window, for purposes of debugging.
Debug.Print "Data source: " & pstrDataSource Debug.Print "Export type: " & plngExportType
Check that at least one record has been selected, and exit if not.
Set lst = Me![lstSelectMultiple] If lst.ItemsSelected.Count = 0 Then MsgBox "Please select at least one record." lst.SetFocus GoTo ErrorHandlerExit Else
Set variables representing the number of columns and rows in the listbox, for use in picking up data from the listbox.
intColumns = lst.ColumnCount intRows = lst.ItemsSelected.Count End If
Set a variable representing the table to fill with selected data, based on the selected data source. I fill a table with data for use in the export, because the OutputTo and TransferSpreadsheet methods require either a table or a query; they can’t work directly with the ItemsSelected collection of a listbox as a complete entity.
strTable = "tblSelected" & Mid(pstrDataSource, 4) Debug.Print "Selected table: " & strTable
Clear old data from selected table.
strSQL = "DELETE * FROM " & strTable DoCmd.SetWarnings False DoCmd.RunSQL strSQL
Set up a recordset based on the selected table.
Set dbs = CurrentDb Set rst = dbs.OpenRecordset(strTable, dbOpenTable) Set dflds = rst.Fields
Write data from selected listbox rows to a table for export.
For Each varItem In lst.ItemsSelected rst.AddNew
Iterate through the columns; the number of columns varies according to the selected data source. Note that the Columns collection is zero-based.
For i = 0 To intColumns – 1 Use Debug.Print statements to print data to the Immediate window for debugging purposes.
Debug.Print "Field name for column " & i & " - " & dflds(i).Name varValue = lst.Column(i, varItem) Debug.Print "Field value: " & varValue
Check for Nulls or zero-length strings and don’t attempt to save the data to the table in these cases.
If IsNull(varValue) = False And varValue <> "" Then dflds(i).Value = Nz(lst.Column(i, varItem)) End If Next i rst.Update Next varItem rst.Close
Use a query based on the table filled with selected records because the export procedures expect a query, not a table.
pstrDataSource = "qrySelected" & Mid(pstrDataSource, 4) Debug.Print "Data source: " & pstrDataSource
Set up a Select Case statement to call the appropriate procedure for each export type, using the Me keyword for the Access Form argument of each procedure, so that the procedure can pick up values from the calling form.
Select Case plngExportType Case 1 Call TransferToCSV(Me) Case 2 Call OutputToWKS(Me) Case 3 Call OutputToTXT(Me) Case 4 Call TransferToWKS(Me) Case 5 Call CreateWKS(Me) End Select ErrorHandlerExit:
Remove the progress bar, in case it might be left over from one of the procedures called in the Select Case statement.
varReturn = SysCmd(acSysCmdRemoveMeter) Exit Sub ErrorHandler: MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description Resume ErrorHandlerExit End Sub
The five procedures called by the above procedure follow, with commentary on the first and last (the middle ones are basically similar to the first).
Public Function OutputToWKS(frm As Access.Form) As Boolean On Error GoTo ErrorHandler
Set variables used to create the appropriate Excel file name. The GetDocsDir function picks up the default Documents directory from tblInfo. This path can be edited as needed in the Docs Path textbox on the main menu.
strFileName = Nz(frm![cboSelectDataSource].Column(0)) strExtension = ".xls" If CheckDocsDir = False Then GoTo ErrorHandlerExit End If strFilePath = GetDocsDir() strFileAndPath = strFilePath & strFileName & strExtension Debug.Print "File name and path: " & strFileAndPath
Initialize the progress bar (using an arbitrary division of three units). The progress bar is displayed in the status bar, as a way of informing users of progress of the export.
varReturn = SysCmd(acSysCmdInitMeter, "Creating output file ...", 3) ‘Update the progress bar. varReturn = SysCmd(acSysCmdUpdateMeter, 1)
Delete the old Excel worksheet, if there is one.
Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(strFileAndPath) = True Then fso.DeleteFile strFileAndPath End If ‘Update the progress bar. varReturn = SysCmd(acSysCmdUpdateMeter, 2)
Create the new worksheet file in the \My Documents\Access Merge folder, using the OutputTo method.
‘Create new worksheet file in Documents\Access Merge folder If Left(pstrDataSource, 1) = "t" Then ‘Data source is a table DoCmd.OutputTo objecttype:=acOutputTable, objectname:=pstrDataSource, outputformat:=acFormatXLS, outputfile:=strFileAndPath, autostart:=False ElseIf Left(pstrDataSource, 1) = "q" Then ‘Data source is a query DoCmd.OutputTo objecttype:=acOutputQuery, objectname:=pstrDataSource, outputformat:=acFormatXLS, outputfile:=strFileAndPath, autostart:=False End If
Test for the existence of the specified worksheet file, with a loop to give it some time to create the file.
Set fso = CreateObject("Scripting.FileSystemObject") For i = 1 To 100 If fso.FileExists(strFileAndPath) = False Then i = i + 1 GoTo TryAgain End If TryAgain: Next i ‘Update the progress bar. varReturn = SysCmd(acSysCmdUpdateMeter, 3) OutputToWKS = True strTitle = "Done" strPrompt = "Worksheet created as " & strFileAndPath MsgBox strPrompt, vbOKOnly + vbInformation, strTitle ErrorHandlerExit: ‘Remove the progress bar. varReturn = SysCmd(acSysCmdRemoveMeter) Exit Function ErrorHandler: MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description OutputToWKS = False Resume ErrorHandlerExit End Function Public Function TransferToCSV(frm As Access.Form) As Boolean On Error GoTo ErrorHandler strFileName = Nz(frm![cboSelectDataSource].Column(0)) strSpec = strFileName & " Export Specification" strExtension = ".csv" If CheckDocsDir = False Then GoTo ErrorHandlerExit End If strFilePath = GetDocsDir() strFileAndPath = strFilePath & strFileName & strExtension Debug.Print "File name and path: " & strFileAndPath ‘Initialize the progress bar (using an arbitrary division of five units). varReturn = SysCmd(acSysCmdInitMeter, "Creating output file ...", 5) ‘Update the progress bar. varReturn = SysCmd(acSysCmdUpdateMeter, 1) ‘Delete old file, if there is one Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(strFileAndPath) = True Then fso.DeleteFile strFileAndPath End If ‘Update the progress bar. varReturn = SysCmd(acSysCmdUpdateMeter, 2)
Create a new comma-delimited text file in \My Documents\Access Merge folder, using the TransferText method.
DoCmd.TransferText transfertype:=acExportDelim, specificationname:=strSpec, tablename:=pstrDataSource, FileName:=strFileAndPath, hasfieldnames:=True ‘Update the progress bar. varReturn = SysCmd(acSysCmdUpdateMeter, 3) ‘Test for existence of specified comma-delimited file, with loop ‘to allow some time to create the file Set fso = CreateObject("Scripting.FileSystemObject") For i = 1 To 100 If fso.FileExists(strFileAndPath) = False Then i = i + 1 GoTo TryAgain End If TryAgain: Next i ‘Update the progress bar. varReturn = SysCmd(acSysCmdUpdateMeter, 4) TransferToCSV = True strTitle = "Done" strPrompt = "Worksheet created as " & strFileAndPath MsgBox strPrompt, vbOKOnly + vbInformation, strTitle ErrorHandlerExit: ‘Remove the progress bar. varReturn = SysCmd(acSysCmdRemoveMeter) Exit Function ErrorHandler: MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description TransferToCSV = False Resume ErrorHandlerExit End Function Public Function OutputToTXT(frm As Access.Form) As Boolean On Error GoTo ErrorHandler strFileName = Nz(frm![cboSelectDataSource].Column(0)) strExtension = ".txt" If CheckDocsDir = False Then GoTo ErrorHandlerExit End If strFilePath = GetDocsDir() strFileAndPath = strFilePath & strFileName & strExtension Debug.Print "File name and path: " & strFileAndPath ‘Initialize the progress bar (using an arbitrary division of three units). varReturn = SysCmd(acSysCmdInitMeter, "Creating output file ...", 3) ‘Update the progress bar. varReturn = SysCmd(acSysCmdUpdateMeter, 1) ‘Delete old file, if there is one Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(strFileAndPath) = True Then fso.DeleteFile strFileAndPath End If ‘Update the progress bar. varReturn = SysCmd(acSysCmdUpdateMeter, 2)
Create a new text file in the \My Documents\Access Merge folder, using the OutputTo method.
If Left(pstrDataSource, 1) = "t" Then ‘Data source is a table DoCmd.OutputTo objecttype:=acOutputTable, objectname:=pstrDataSource, outputformat:=acFormatTXT, outputfile:=strFileAndPath, autostart:=False ElseIf Left(pstrDataSource, 1) = "q" Then ‘Data source is a query DoCmd.OutputTo objecttype:=acOutputQuery, objectname:=pstrDataSource, outputformat:=acFormatTXT, outputfile:=strFileAndPath, autostart:=False End If ‘Test for existence of specified text file, with loop ‘to allow some time to create the file Set fso = CreateObject("Scripting.FileSystemObject") For i = 1 To 100 If fso.FileExists(strFileAndPath) = False Then i = i + 1 GoTo TryAgain End If TryAgain: Next i ‘Update the progress bar. varReturn = SysCmd(acSysCmdUpdateMeter, 3) OutputToTXT = True strTitle = "Done" strPrompt = "Text file created as " & strFileAndPath MsgBox strPrompt, vbOKOnly + vbInformation, strTitle ErrorHandlerExit: ‘Remove the progress bar. varReturn = SysCmd(acSysCmdRemoveMeter) Exit Function ErrorHandler: MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description OutputToTXT = False Resume ErrorHandlerExit End Function Public Function TransferToWKS(frm As Access.Form) As Boolean On Error GoTo ErrorHandler strFileName = Nz(frm![cboSelectDataSource].Column(0)) strSpec = strFileName & " Export Specification" strExtension = ".xls" If CheckDocsDir = False Then GoTo ErrorHandlerExit End If strFilePath = GetDocsDir() strFileAndPath = strFilePath & strFileName & strExtension Debug.Print "File name and path: " & strFileAndPath ‘Initialize the progress bar (using an arbitrary division of four units). varReturn = SysCmd(acSysCmdInitMeter, "Creating output file ...", 4) ‘Update the progress bar. varReturn = SysCmd(acSysCmdUpdateMeter, 1) ‘Delete old file, if there is one Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(strFileAndPath) = True Then fso.DeleteFile strFileAndPath End If ‘Update the progress bar. varReturn = SysCmd(acSysCmdUpdateMeter, 2) Debug.Print "Data source: " & pstrDataSource
Create a new worksheet file in the \My Documents\Access Merge folder, using the TransferSpreadsheet method.
DoCmd.TransferSpreadsheet transfertype:=acExport, tablename:=pstrDataSource, FileName:=strFileAndPath, hasfieldnames:=True ‘Update the progress bar. varReturn = SysCmd(acSysCmdUpdateMeter, 3) ‘Test for existence of specified worksheet file, with loop ‘to allow some time to create the file Set fso = CreateObject("Scripting.FileSystemObject") For i = 1 To 100 If fso.FileExists(strFileAndPath) = False Then i = i + 1 GoTo TryAgain End If TryAgain: Next i ‘Update the progress bar. varReturn = SysCmd(acSysCmdUpdateMeter, 4) TransferToWKS = True strTitle = "Done" strPrompt = "Worksheet created as " & strFileAndPath MsgBox strPrompt, vbOKOnly + vbInformation, strTitle ErrorHandlerExit: ‘Remove the progress bar. varReturn = SysCmd(acSysCmdRemoveMeter) Exit Function ErrorHandler: MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description TransferToWKS = False Resume ErrorHandlerExit End Function Public Function CreateWKS(frm As Access.Form) As Boolean On Error GoTo ErrorHandler Dim rstData As DAO.Recordset strFileName = Nz(frm![cboSelectDataSource].Column(0)) strExtension = ".xls" If CheckDocsDir = False Then GoTo ErrorHandlerExit End If strFilePath = GetDocsDir() strFileAndPath = strFilePath & strFileName & strExtension Debug.Print "File name and path: " & strFileAndPath ‘Delete old file, if there is one Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(strFileAndPath) = True Then fso.DeleteFile strFileAndPath End If
Set a global Excel application variable; if Excel is not running, the error handler defaults to CreateObject.
Set gappExcel = GetObject(, "Excel.Application") Create a new workbook, and set a reference to its first worksheet.
Set wkb = gappExcel.Workbooks.Add Set wks = wkb.Worksheets(1) wks.Activate gappExcel.Application.Visible = True
Excel columns are lettered, so initialize a column letter variable with 64, so the first letter used will be A.
lngASCII = 64 lngStartLetter = 64
Initialize a row number variable with 1, to start on the first row.
i = 1 Create a recordset based on the selected data source.
Set dbs = CurrentDb Set rstData = dbs.OpenRecordset(pstrDataSource, dbOpenDynaset)
Write field names to column headings of worksheet, by iterating through the Fields collection of the recordset.
Set dflds = rstData.Fields lngCount = dflds.Count For Each dfld In dflds lngASCII = lngASCII + 1 strASCII = Chr(lngASCII) strRange = strASCII & CStr(i) Debug.Print "Range: " & strRange Set rng = wks.Range(strRange) Debug.Print "Field name: " & dfld.Name rng.Value = dfld.Name Next dfld
Save the value of the highest letter used for titles, to use in writing data to rows in the worksheet.
lngEndLetter = lngASCII lngNoColumns = lngASCII - 64 Debug.Print "No. of columns: " & lngNoColumns
Write data from the selected query to rows of the worksheet.
With rstData Do While Not .EOF
Go to the next row in the worksheet, and reinitialize the column letter value with 64, to start with column A again.
lngASCII = 64 Increment the row number.
i = i + 1 Set up a loop for writing data from the appropriate number of fields to this row in the worksheet.
For j = 0 To lngNoColumns - 1 lngASCII = lngASCII + 1 strASCII = Chr(lngASCII) strRange = strASCII & CStr(i) Set rng = wks.Range(strRange) Debug.Print "Range: " & strRange Debug.Print "Value: " & Nz(dflds(j).Value)
Turn off the error handler, to prevent errors when writing nonstandard data to the worksheet (such as dates way in the past).
On Error Resume Next Write data from a field to a cell in the worksheet.
rng.Value = Nz(dflds(j).Value) Next j .MoveNext
Turn the error handler back on.
On Error GoTo ErrorHandler Loop .Close End With
Save the worksheet to the previously created name, and format the columns and rows. You can do as much formatting as you wish—use the Excel macro recorder to capture the syntax needed.
wks.SaveAs strFileAndPath wks.Rows("1:1").Select gappExcel.Selection.Font.Bold = True With gappExcel.Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With strASCII = Chr(lngEndLetter) gappExcel.Columns("A:" & strASCII).Select gappExcel.Columns("A:" & strASCII).EntireColumn.AutoFit gappExcel.Rows("1:" & i).Select gappExcel.Selection.RowHeight = 28
Put up a success message indicating that the worksheet has been created.
strTitle = "Done" strPrompt = "Worksheet created as " & strFileAndPath MsgBox strPrompt, vbOKOnly + vbInformation, strTitle ErrorHandlerExit: ‘Remove the progress bar. varReturn = SysCmd(acSysCmdRemoveMeter) Exit Function ErrorHandler: If Err = 429 Then ‘Excel is not running; open Excel with CreateObject. Set gappExcel = CreateObject("Excel.Application") Resume Next Else MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description Resume ErrorHandlerExit End If End Function
The export types produce various types of files, which are discussed below. The OutputTo method produces the worksheet shown in Figure 13.8.
Figure 13.8
The worksheet is very plain—the same font is used throughout, and all the columns and rows are the default size. If all you need is the data, this will do, but if you need a more attractively formatted worksheet, you will need to use Automation code to create the worksheet, so you can work with it in code. The TransferSpreadsheet method creates a similar, plain worksheet, and the comma-delimited method creates a comma-delimited (.csv) file, which can be opened in Excel (it looks just like the .wks file) or used for importing into many other file formats, including those that can’t import directly from an Access database. It can also be opened in Notepad or another text editor.
If you select the Plain text file selection, you will get a text file that has some minimal (and ugly) formatting accomplished with ASCII characters, and wrapped to illegibility if the data source has more than a few columns. Figure 13.9 shows the plain text file created from the Employee Phones data source (which has only four columns).
Figure 13.9
The last selection (Automation) uses VBA code that works with the newly created worksheet to do some formatting. The amount of formatting you can do with Automation code is virtually unlimited, and you can use the Excel macro recorder to help with the syntax needed for various operations. Figure 13.10 shows the formatted worksheet created by this procedure.
Figure 13.10
This worksheet has columns that are adjusted to fit their contents and rows that are taller than normal so that wrapped descriptions can be read. The column headings are bold, and the headings row is underlined.
Datasheet Form
The Export to Excel (Datasheet) form has two comboboxes in its header, for selecting the data source and export type, and also a set of controls for filtering the data source by a selected value. The code for cboSelectDataSource follows. It clears the txtFilterString textbox, sets several public variables for use later in the code, and then makes the appropriate subform visible, and the other subforms invisible, depending on the data source choice. After this, the cboFilterField and cboFilterValue comboboxes are cleared, and cboFilterField’s row source is set to a version of the selected data source query (with the Alpha suffix) that has its columns in alphabetical order, for easier selection from the combobox’s list. Finally, the fraRecords option group is enabled, so the user can select to filter the records.
Private Sub cboSelectDataSource_AfterUpdate() On Error GoTo ErrorHandler Me![txtFilterString].Value = Null pstrDataSource = Me![cboSelectDataSource].Column(1) pstrQuery = Nz(Me![cboSelectDataSource].Column(1)) & "Alpha" Select Case pstrDataSource Case "qryContacts" Me![subContacts].Visible = True Me![subContacts].Locked = True Me![subEBooks].Visible = False Me![subEmployeePhones].Visible = False Case "qryEBooksAndAuthors" Me![subContacts].Visible = False Me![subEBooks].Visible = True Me![subEBooks].Locked = True Me![subEmployeePhones].Visible = False Case "qryEmployeePhones" Me![subContacts].Visible = False Me![subEBooks].Visible = False Me![subEmployeePhones].Visible = True Me![subEmployeePhones].Locked = True End Select Me![cboFilterField].Value = Null Me![cboFilterValue].Value = Null Me![cboFilterField].RowSource = pstrDataSource & "Alpha" Me![fraRecords].Enabled = True Me![fraRecords].Value = 1 ErrorHandlerExit: Exit Sub ErrorHandler: MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description Resume ErrorHandlerExit End Sub
The AfterUpdate event procedure on cboExportType is the same as the procedure for the corresponding control on the listbox form.
On making a selection from the Records option group, an AfterUpdate event procedure runs. It is listed below, with commentary for the first case.
Private Sub fraRecords_AfterUpdate() On Error GoTo ErrorHandler Dim intRecords As Integer
Run a procedure to clear the source objects of the subforms, set filter comboboxes to Null, and delete old tables created by make-table queries.
Call ClearList intRecords = Nz(Me![fraRecords].Value, 1)
Set up a Select Case statement to process each data source separately.
Select Case pstrDataSource Case "qryContacts"
Make the appropriate subform visible and locked, and the others invisible.
Me![subContacts].Visible = True Me![subContacts].Locked = True Me![subEBooks].Visible = False Me![subEmployeePhones].Visible = False If intRecords = 1 Then
If All Records was selected, assign fsubContactsAll as the subContacts subform’s source object, and disable the filter comboboxes.
Me![subContacts].SourceObject = "fsubContactsAll" Me![cboFilterField].Enabled = False Me![cboFilterField].Value = "" Me![cboFilterValue].Enabled = False ElseIf intRecords = 2 Then
If Filtered Records was selected, clear subContacts subform’s source object (it will be assigned after selecting a filter value), and enable the filter comboboxes.
Me![subContacts].SourceObject = "" Me![cboFilterField].Enabled = True Me![cboFilterField].Value = "" Me![cboFilterValue].Enabled = False End If Case "qryEBooksAndAuthors" Me![subContacts].Visible = False Me![subEBooks].Visible = True Me![subEBooks].Locked = True Me![subEmployeePhones].Visible = False If intRecords = 1 Then Me![subEBooks].SourceObject = "fsubEBooksAll" Me![cboFilterField].Enabled = False Me![cboFilterField].Value = "" Me![cboFilterValue].Enabled = False ElseIf intRecords = 2 Then Me![subEBooks].SourceObject = "" Me![cboFilterField].Enabled = True Me![cboFilterField].Value = "" Me![cboFilterValue].Enabled = False End If Case "qryEmployeePhones" Me![subContacts].Visible = False Me![subEBooks].Visible = False Me![subEmployeePhones].Visible = True Me![subEmployeePhones].Locked = True If intRecords = 1 Then Me![subEmployeePhones].SourceObject = "fsubEmployeePhonesAll" Me![cboFilterField].Enabled = False Me![cboFilterField].Value = "" Me![cboFilterValue].Enabled = False ElseIf intRecords = 2 Then Me![subEmployeePhones].SourceObject = "" Me![cboFilterField].Enabled = True Me![cboFilterField].Value = "" Me![cboFilterValue].Enabled = False End If End Select ErrorHandlerExit: Exit Sub ErrorHandler: MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description Resume ErrorHandlerExit End Sub
As with exporting to Word (see Chapter 11, Working with Word, for a more detailed discussion), a SQL string is constructed as a row source for cboFilterValue. cboFilterValue’s AfterUpdate event procedure processes the field data type similarly to the Word procedure, but then applies the filter to the selected record source and makes a table to it. It then assigns the appropriate filtered subform as the source object of the appropriate subform, as follows:
Me![txtFilterString] = strFilter strQuery = "qmakMatchingRecords" strSQL = "SELECT " & pstrQuery & ".* INTO tmakMatchingRecords " & "FROM " & pstrQuery & " WHERE " & strFilter & ";" Debug.Print "SQL Statement: " & strSQL Set qdf = dbs.CreateQueryDef(strQuery, strSQL) qdf.Execute Me![cboFilterField].Value = Null Me![cboFilterValue].Value = Null Debug.Print "Data source: " & pstrDataSource Select Case pstrDataSource Case "qryContacts" Me![subContacts].SourceObject = "fsubContactsFiltered" Debug.Print "subContacts source object: " & Me![subContacts].SourceObject Case "qryEBooksAndAuthors" Me![subEBooks].SourceObject = "fsubEBooksFiltered" Debug.Print "subEBooks source object: " & Me![subEBooks].SourceObject Case "qryEmployeePhones" Me![subEmployeePhones].SourceObject = "fsubEmployeePhonesFiltered" Debug.Print "subEmployeePhones source object: " & Me![subEmployeePhones].SourceObject End Select
Figure 13.11 shows the datasheet form, with the EBooks data source filtered for the Fantasy category.
Figure 13.11
The Export Data command button’s Click event procedure checks for required choices, as with the comparable procedure on the listbox form, but then uses a different technique to work with the table created by a make-table query, for filtered records.
Private Sub cmdExportData_Click() On Error GoTo ErrorHandler ‘Check that a data source has been selected. Set cbo = Me![cboSelectDataSource] pstrDataSource = Nz(cbo.Column(1)) If pstrDataSource = "" Then MsgBox "Please select a data source." cbo.SetFocus cbo.Dropdown GoTo ErrorHandlerExit End If ‘Check that an export type and file type have been selected. If plngExportType = 0 Then MsgBox "Please select an export type" Me![cboSelectExportType].SetFocus Me![cboSelectExportType].Dropdown GoTo ErrorHandlerExit End If intRecords = Me![fraRecords].Value
Determine what data source and export type are to be used, and whether all records or just filtered records are to be merged.
If Me![fraRecords].Value = 2 Then Filtered records—change data source to filtered table.
pstrDataSource = "tmakMatchingRecords" Else
Keep the selection made in cboSelectDataSource.
End If Debug.Print "Data source: " & pstrDataSource Debug.Print "Export type: " & plngExportType
Set up a Select Case statement to run the appropriate procedure for processing each export type separately.
Select Case plngExportType Case 1 Call TransferToCSV(Me) Case 2 Call OutputToWKS(Me) Case 3 Call OutputToTXT(Me) Case 4 Call TransferToWKS(Me) Case 5 Call CreateWKS(Me) End Select ErrorHandlerExit: Close #1 ‘Remove the progress bar. varReturn = SysCmd(acSysCmdRemoveMeter) Exit Sub ErrorHandler: MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description Resume ErrorHandlerExit End Sub
EAN: 2147483647
Pages: 124