Practical Examples: Using Automation to Extend the Functionality of Your Applications
Many potential applications of automation exist for your applications. One of them is discussed in this section.
The form in Figure 22.15 enables users to select a table or query to send to Excel. The form is called frmSendToExcel.
The Load event of the form is used to add all the table and query names to the list box. The Load event is shown in Listing 22.16. Notice that the function uses the AllTables and AllQueries collections of the current database to populate the list box, excluding all the system tables.
Listing 22.16 Adding Table and Query Names to the List Box
Private Sub Form_Load()
Dim vntObject As Variant
'Loop through each table, adding its name
'to the list box
For Each vntObject In CurrentData.AllTables
If Left(vntObject.Name, 4) <> "MSys" Then
Me.lstTables.AddItem vntObject.Name
End If
Next vntObject
'Loop through each query, adding its name to
'the list box
For Each vntObject In CurrentData.AllQueries
Me.lstTables.AddItem vntObject.Name
Next vntObject
End Sub
The Click event of the cmdSendToExcel command button sends the selected table or query to Excel. Listing 22.17 shows this code.
Listing 22.17 Sending a Table or Query to Excel
Private Sub cmdSendToExcel_Click()
On Error GoTo cmdSendToExcel_Err
Dim objWS As Excel.Worksheet
Dim rstData As ADODB.Recordset
Dim rstCount As ADODB.Recordset
Dim fld As ADODB.Field
Dim intColCount As Integer
Dim intRowCount As Integer
Set rstData = New ADODB.Recordset
rstData.ActiveConnection = CurrentProject.Connection
Set rstCount = New ADODB.Recordset
rstCount.ActiveConnection = CurrentProject.Connection
'Invoke Hourglass
DoCmd.Hourglass True
'Try to Create Recordset and Create Excel Object
If CreateRecordset(rstData, rstCount, lstTables.Value) Then
If CreateExcelObj() Then
'Add a Workbook
gobjExcel.Workbooks.Add
'Create a reference to the Active Sheet
Set objWS = gobjExcel.ActiveSheet
intRowCount = 1
intColCount = 1
'Loop through the Fields collection
'Make each field name a column heading in Excel
For Each fld In rstData.Fields
If fld.Type <> adLongVarBinary Then
objWS.Cells(1, intColCount).Value = fld.Name
intColCount = intColCount + 1
End If
Next fld
'Send Recordset to Excel
objWS.Range("A2").CopyFromRecordset rstData, 500
gobjExcel.Range("A1").Select
'Set up AutoFilter
gobjExcel.Selection.AutoFilter
gobjExcel.Visible = True
Else
MsgBox "Excel Not Successfully Launched"
End If
Else
MsgBox "Too Many Records to Send to Excel"
End If
cmdSendToExcel_Exit:
DoCmd.Hourglass False
Set objWS = Nothing
Set rstCount = Nothing
Set rstData = Nothing
Set fld = Nothing
Exit Sub
cmdSendToExcel_Err:
MsgBox "Error # " & Err.Number & ": " & Err.Description
Resume cmdSendToExcel_Exit
End Sub
The routine begins by creating a recordset object using the CreateRecordSet function shown in Listing 22.18. It then attempts to launch Excel. If it is successful, it loops through the Fields collection of the recordset resulting from the selected table or query. It lists all the field names as column headings in Excel. Next, it uses the CopyFromRecordset method of the range object to copy all the field values to the rows in the Excel worksheet. Finally, it issues the AutoFilter method so that the user easily can manipulate the data in Excel, filtering it as necessary (see Figure 22.16).
CAUTION
Although extremely easy to use, the CopyFromRecordset method of the range object has one major limitation. If the table or query used to populate the recordset being sent to Excel contains an OLE object field, the method will fail. There are two solutions to this problem. The simplest solution is to always base the recordset sent to Excel on a query. Do not include any OLE object fields in the query. A second solution is to use a less elegant alternative to the CopyFromRecordset method. Simply loop through the recordset one record at a time. As each record is visited, send it to the appropriate row and column. Because the first method is not only easier to code, but is more optimized, you should use it wherever possible.
Listing 22.18 Checking Recordset Size
Function CreateRecordset(rstData As ADODB.Recordset, _
rstCount As ADODB.Recordset, _
strTableName As String)
On Error GoTo CreateRecordset_Err
'Create recordset that contains count of records in query result
rstCount.Open "Select Count(*) As NumRecords from " & strTableName
'If more than 500 records in query result, return false
'Otherwise, create recordset from query
If rstCount!NumRecords > 500 Then
CreateRecordset = False
Else
rstData.Open strTableName
CreateRecordset = True
End If
CreateRecordset_Exit:
'Common exit point; destroy the rstCount recordset
Set rstCount = Nothing
Exit Function
CreateRecordset_Err:
'Display error message and resume at common exit point
MsgBox "Error # " & Err.Number & ": " & Err.Description
Resume CreateRecordset_Exit
End Function
This routine, found in basUtils, ensures that the recordset is not too large to send to Excel. If the size of the recordset is acceptable, it creates the recordset and returns True.