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