Code Behind Forms Code Samples

I have discussed creating event procedures for forms and form controls in preceding chapters; here, I’ll give some examples of standard event procedures and some event procedures for special purposes.

The AfterUpdate event procedure listed below puts different text into a locked textbox control on the fpriOrders form in the sample Toy Workshop database, depending on which option the user selects in the Shipping Method option group:

 Private Sub fraShippingMethodID_AfterUpdate() On Error GoTo ErrorHandler        Dim intShip As Integer    Dim strShipInfo As String        intShip = Nz(Me![fraShippingMethodID].Value)        Select Case intShip           Case 1          ‘UPS          strShipInfo = "UPS pickup at 3 PM"                 Case 2          ‘FedEx          strShipInfo = "Put in FedEx box on corner of 4th and Main St."                 Case 3          ‘USPS          strShipInfo = "U.S. Mail pickups at 10 AM and 4 PM"                 Case 4          ‘Air Express          strShipInfo = "Call Air Express for pickup at 555-111-2222"                 Case 5          ‘Speedy Messenger Service          strShipInfo = "Call Extension 45 for Speedy pickup"                 Case Else          ‘No selection made          strShipInfo = "No shipping selection made"        End Select        Me![txtShippingInfo].Value = strShipInfo     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub  

For the Select Case statement to work on a new record, you have two alternatives: (1) Don’t assign a default value to the Shipping Method option group, so the user will always need to select a value, or (2) assign the default text for the default method to the txtShippingInfo textbox from the form’s BeforeInsert event.

Figure 7.9 shows the fpriOrders form in the sample Toy Workshop (Modules Finish) database after selecting UPS as the shipping method.

Figure 7.9

Setting the value of the txtShippingInfo textbox from the option group’s AfterUpdate event is fine if you only need to see the message when an option is selected for a new order, or changed for an existing order. However, if you always want to see the appropriate message when navigating from record to record, it’s best to move the code from the event procedure to a Sub procedure that can be called from the option group’s AfterUpdate event procedure and the form’s Current event procedure, using the syntax

Call ShippingMethod

The option group event procedure is now:

 Private Sub fraShippingMethodID_AfterUpdate()    Call ShippingInfo End Sub 

This procedure doesn’t need an error handler, because the ShippingInfo Sub has its own error handler. The new Sub procedure contains exactly the same code as the original fraShippingMethodID_AfterUpdate event procedure.

There is one final modification that might be needed in some cases, such as when you need to respond to identical option groups on several different forms. While you could create the same Sub procedure in each form’s module, it is more efficient to place the Sub procedure in a standard module and make it public instead of private. In this case, you need to make a change in the procedure, replacing the Me keyword that references the form (this keyword will only work in a code behind forms module) with an Access form argument that is set with the Me keyword when the procedure is called. The public Sub procedure is listed below:

 Public Sub ShippingInfo(frm As Access.Form) On Error GoTo ErrorHandler        Dim intShip As Integer    Dim strShipInfo As String        intShip = Nz(frm![fraShippingMethodID].Value)        Select Case intShip           Case 1          ‘UPS          strShipInfo = "UPS pickup at 3 PM"                 Case 2          ‘FedEx          strShipInfo = "Put in FedEx box on corner of 4th and Main St."                 Case 3          ‘USPS          strShipInfo = "U.S. Mail pickups at 10 AM and 4 PM"                 Case 4          ‘Air Express          strShipInfo = "Call Air Express for pickup at 555-111-2222"                 Case 5          ‘Speedy Messenger Service          strShipInfo = "Call Extension 45 for Speedy pickup"                 Case Else          ‘No selection made          strShipInfo = "No shipping selection made"        End Select        frm![txtShippingInfo].Value = strShipInfo     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub 

and this is the modified option group event procedure:

 Private Sub fraShippingMethodID_AfterUpdate()    Call ShippingInfo(Me) End Sub 

The same Call line is needed in the Form_Current event procedure, so that you will see the correct message when navigating from record to record on the form.

New Thing Form

When adding a new record to a table, it may not be a good idea to let users add records on the same form used to edit existing records. It is far too easy to create a record missing crucial data because Access saves a record when (for example) you move the focus to a subform, and it’s not easy to put error trapping on all the possible events where a save may occur.

Instead, it is sometimes advisable to use a special New Thing form to accept the data, and only create a new table record if there is valid data in all fields that must be filled in for a valid record. For example, to add records to tblEmployees, you can use frmNewEmployee, and keep frmEmployees for editing existing records in that table. A New Thing form can be implemented in several ways, ranging from the most complex to the simplest:

• Create a Class module and all the required code to create a custom object corresponding to the table, and check the properties of the object; if the properties corresponding to required fields have valid values, copy them to a new record in the table. In my opinion, this is overkill just to save a new record in a more secure manner.

• Bind the New Thing form to a temp table that has the same fields as the regular table, with the exception of an AutoNumber field (if there is one). After the new record has been validated, append the record from the temp table to the regular table. This method can be useful, especially if you want to be able to work with the data on the New Thing form before appending it to the main table (for example, to print a report with the new record’s data).

• On an unbound form, check the values of required fields directly from the values in controls on the form, and add a new record to the table only if all required fields have valid values. This is relatively easy to implement; I’ll give details for this method below.

To create a New Thing form for adding new employees to tblEmployees in the sample Toy Workshop database (Modules Start), first make a copy of frmEmployees and name it frmNewEmployee. You will need to make several changes to both frmEmployees and frmNewEmployee, as listed below.

frmEmployees Changes

• Set the form’s AllowAdditions property to No.

• Delete the subMaxEmployeeID subform.

• Remove the Form_BeforeInsert and NewEmployeeID procedures from the form’s code module.

• Add a New Employee button to the footer of frmEmployees to open frmNew Employee.

frmNewEmployee Changes

• Delete the form’s record source (this makes it an unbound form).

• Set the form’s Data Entry property to Yes.

• Remove the record selector combobox from the form header (it’s not needed for creating a new form), and shrink the header to nothing.

• Delete the control source of each bound control on the form (but leave the row sources of comboboxes).

• Set the form’s caption to “New Employee.”

• Rename the original Close Form button to Cancel and Close, and add another button with the caption “Save and Close.” The Cancel and Close button just closes the form, without creating a new Employee record (the code returns to frmEmployees rather than to the main menu). The Save and Close button does the checking of required fields and either informs the user about missing information in a field or appends a new record to tblEmployees. The cmdClose and cmdSave Click event procedures are listed below.

   Private Sub cmdClose_Click() On Error GoTo ErrorHandler        Set prj = Application.CurrentProject    If prj.AllForms("frmEmployees").IsLoaded Then       Forms![frmEmployees].Visible = True    Else       DoCmd.OpenForm "frmEmployees"    End If ErrorHandlerExit:    DoCmd.Close acForm, Me.Name    Exit Sub ErrorHandler:    If Err.Number = 2467 Then       Resume ErrorHandlerExit    Else       MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description       Resume ErrorHandlerExit    End If End Sub Private Sub cmdSave_Click() On Error GoTo ErrorHandler        Dim dbs As DAO.Database    Dim rst As DAO.Recordset    Dim strPrompt As String    Dim strTitle As String        ‘Check values of variables and exit if required data is missing    strTitle = "Missing data"    If Nz(Me![txtFirstName].Value) = "" Then       strPrompt = "First name missing; can’t add new employee record"       MsgBox strPrompt, vbOKOnly, strTitle       GoTo ErrorHandlerExit    ElseIf Nz(Me![txtLastName].Value) = "" Then       strPrompt = "Last name missing; can’t add new employee record"       MsgBox strPrompt, vbOKOnly, strTitle       GoTo ErrorHandlerExit    ElseIf Nz(Me![txtTitle].Value) = "" Then       strPrompt = "Title missing; can’t add new employee record"       MsgBox strPrompt, vbOKOnly, strTitle       GoTo ErrorHandlerExit    ElseIf Nz(Me![txtDateHired].Value, #1/1/1980#) = #1/1/1980# Then       strPrompt = "Date hired missing; can’t add new employee record"       MsgBox strPrompt, vbOKOnly, strTitle       GoTo ErrorHandlerExit    End If        ‘All required fields have data; add new records to tblEmployees    ‘and tblEmployeesConfidential    Set dbs = CurrentDb    Set rst = dbs.OpenRecordset("tblEmployees")    rst.AddNew    rst![EmployeeID] = mstrEmployeeID    rst![DepartmentName] = Nz(Me![cboDepartmentName].Value)    rst![FirstName] = Me![txtFirstName].Value    rst![MiddleName] = Nz(Me![txtMiddleName].Value)    rst![LastName] = Me![txtLastName].Value    rst![Title] = Me![txtTitle].Value    rst![EmailName] = Nz(Me![txtEmailName].Value)    rst![Extension] = (Me![txtExtension].Value)    rst![Address] = Nz(Me![txtAddress].Value)    rst![City] = Nz(Me![txtCity].Value)    rst![StateOrProvince] = Nz(Me![txtStateOrProvince].Value)    rst![PostalCode] = Nz(Me![txtPostalCode].Value)    rst![HomePhone] = Nz(Me![txtHomePhone].Value)    rst![WorkPhone] = Nz(Me![txtWorkPhone].Value)    rst![Birthdate] = Nz(Me![txtBirthdate].Value)    rst![DateHired] = Me![txtDateHired].Value    rst![SupervisorID] = Nz(Me![cboSupervisorID].Value)    rst.Update    rst.Close        Set prj = Application.CurrentProject    If prj.AllForms("frmEmployees").IsLoaded Then       Forms![frmEmployees].Visible = True       Forms![frmEmployees].Requery    Else       DoCmd.OpenForm "frmEmployees"    End If    DoCmd.Close acForm, Me.Name     ErrorHandlerExit:    Exit Sub ErrorHandler:    If Err.Number = 2467 Then       Resume ErrorHandlerExit    Else       MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description       Resume ErrorHandlerExit    End If End Sub 

• Add a module-level mstrEmployeeID variable to the Declarations section of the code behind forms module.

• Remove the section that adds a new record to tblEmployeesConfidential from the NewEmployeeID procedure, and modify the remaining code to write the new Employee ID to the textbox on the form. The modified procedure is below.

   Private Sub NewEmployeeID() On Error GoTo ErrorHandler        Dim lngEmployeeID As Long        Me![subMaxEmployeeID].Form.Requery    lngEmployeeID = Me![subMaxEmployeeID].Form![txtNumericID] + 1    mstrEmployeeID = Format(lngEmployeeID, "00000")    Me![txtEmployeeID] = mstrEmployeeID     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub 

• Remove the Current event procedure, since there is no record selector combo box to clear.

• Move the Call NewEmployeeID line from the BeforeInsert event to the Load event of the form (BeforeInsert won’t work on an unbound form).

The finished frmEmployees and frmNewEmployee forms can be seen in the Modules Finish version of the sample Toy Workshop database. frmNewEmployee is shown in Figure 7.10.

Figure 7.10

Sort and Filter Forms

If you have data that you need to view sorted and/or filtered by different fields, you can use code on the AfterUpdate event of a set of comboboxes to create a filter string, which can then be used to filter the data source of a subform showing the filter results, or to filter a form popped up from a command button. The Dynamic Search form shown in Figure 7.11 is based on a table of 500 contacts, with comboboxes allowing you to filter the data for a value in any of five fields.

Figure 7.11

Initially, the form opens unfiltered, and all the contacts are displayed in the datasheet subform. You can sort by any column by selecting the column and clicking the Sort Ascending or Sort Descending toolbar button—no need to write code for that. Figure 7.12 shows the datasheet sorted by the Company Name field.

Figure 7.12

To filter the contacts by a value, select one of the field options, and then select a value in the corresponding combobox. Figure 7.13 shows the results of filtering by Last Meeting Date = 5/9/2002.

Figure 7.13

The Dynamic Search form is bound to tblInfo, so that filter-related information can be saved in this table. Figure 7.14 shows the latest filter selection saved to the FilterType, FilterValue, and FilterString fields in tblInfo.

Figure 7.14

AfterUpdate events on the five field comboboxes create a filter string and save it to the FilterString field in tblInfo. The AfterUpdate event procedure for the Company combobox follows. Because CompanyName is a text field, the value picked up from the combobox is wrapped in single quotes, using Chr$(39). (Numeric values don’t need the quotes, and dates are wrapped in number signs.) The filter string is then used to create a query called qryFilteredContacts, using the CreateAndTestQuery function, and the newly created query is assigned to the datasheet subform’s RecordSource property.

 Private Sub cboCompany_AfterUpdate() On Error GoTo ErrorHandler        Dim strCompany As String        strCompany = Nz(Me![cboCompany])    If strCompany = "" Then       GoTo ErrorHandlerExit    End If        strFilter = "[CompanyName] = " & Chr$(39) & strCompany & Chr$(39)    Me![FilterString] = strFilter    DoCmd.RunCommand acCmdSaveRecord    strRecordSource = "qryContacts"    strQuery = "qryFilteredContacts"    strSQL = "SELECT * FROM " & strRecordSource & " WHERE "        & strFilter & ";"    Debug.Print "SQL Statement: " & strSQL    Debug.Print CreateAndTestQuery(strQuery, strSQL)        & " records found"    Me![subSearchResults].Form.RecordSource = strQuery     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub 

The option group’s AfterUpdate event procedure enables the appropriate combobox, depending on the option chosen, and disables the others, and makes the txtFilter textbox visible or invisible, depending on whether a filter field is selected or not. Appropriate text is also written to the caption of the cmdContacts command button. If the Unfiltered option is selected, qryContacts is assigned to the datasheet subform’s record source. If a filter field is selected, that assignment is made from the AfterUpdate event procedure of that field’s combobox.

 Private Sub fraFilter_AfterUpdate() On Error GoTo ErrorHandler        Dim intFilter As Integer        intFilter = Me![fraFilter].Value    Me![FilterValue] = Null        Select Case intFilter           Case 1       ‘Unfiltered       Me![cboCity].Enabled = False       Me![cboCity].ControlSource = ""       Me![cboCountry].Enabled = False       Me![cboCountry].ControlSource = ""       Me![cboCompany].Enabled = False       Me![cboCompany].ControlSource = ""       Me![cboLastMeetingDate].Enabled = False       Me![cboLastMeetingDate].ControlSource = ""       Me![cboSalary].Enabled = False       Me![cboSalary].ControlSource = ""       Me![cmdContacts].Caption = "Open Unfiltered Contacts Form"       Me![txtFilter].Visible = False       Me![subSearchResults].Form.RecordSource = "qryContacts"                    Case 2       ‘Filter by City       Me![cboCity].Enabled = True       Me![cboCity].ControlSource = "FilterValue"       Me![cboCity].SetFocus       Me![cboCity].Dropdown       Me![cboCountry].Enabled = False       Me![cboCountry].ControlSource = ""       Me![cboCompany].Enabled = False       Me![cboCompany].ControlSource = ""       Me![cboLastMeetingDate].Enabled = False       Me![cboLastMeetingDate].ControlSource = ""       Me![cboSalary].Enabled = False       Me![cboSalary].ControlSource = ""       Me![cmdContacts].Caption = "Open Filtered Contacts Form"       Me![txtFilter].Visible = True              Case 3       ‘Filter by Country       Me![cboCity].Enabled = False       Me![cboCity].ControlSource = ""       Me![cboCountry].Enabled = True       Me![cboCountry].ControlSource = "FilterValue"       Me![cboCountry].SetFocus       Me![cboCountry].Dropdown       Me![cboCompany].Enabled = False       Me![cboCompany].ControlSource = ""       Me![cboLastMeetingDate].Enabled = False       Me![cboLastMeetingDate].ControlSource = ""       Me![cboSalary].Enabled = False       Me![cboSalary].ControlSource = ""       Me![cmdContacts].Caption = "Open Filtered Contacts Form"       Me![txtFilter].Visible = True              Case 4       ‘Filter by Company Name       Me![cboCity].Enabled = False       Me![cboCity].ControlSource = ""       Me![cboCountry].Enabled = False       Me![cboCountry].ControlSource = ""       Me![cboCompany].Enabled = True       Me![cboCompany].ControlSource = "FilterValue"       Me![cboCompany].SetFocus       Me![cboCompany].Dropdown       Me![cboLastMeetingDate].Enabled = False       Me![cboLastMeetingDate].ControlSource = ""       Me![cboSalary].Enabled = False       Me![cboSalary].ControlSource = ""       Me![cmdContacts].Caption = "Open Filtered Contacts Form"       Me![txtFilter].Visible = True              Case 5       ‘Filter by Last Meeting Date       Me![cboCity].Enabled = False       Me![cboCity].ControlSource = ""       Me![cboCountry].Enabled = False       Me![cboCountry].ControlSource = ""       Me![cboCompany].Enabled = False       Me![cboCompany].ControlSource = ""       Me![cboLastMeetingDate].Enabled = True       Me![cboLastMeetingDate].ControlSource = "FilterValue"       Me![cboLastMeetingDate].SetFocus       Me![cboLastMeetingDate].Dropdown       Me![cboSalary].Enabled = False       Me![cboSalary].ControlSource = ""       Me![cmdContacts].Caption = "Open Filtered Contacts Form"       Me![txtFilter].Visible = True              Case 6       ‘Filter by Salary       Me![cboCity].Enabled = False       Me![cboCity].ControlSource = ""       Me![cboCountry].Enabled = False       Me![cboCountry].ControlSource = ""       Me![cboCompany].Enabled = False       Me![cboCompany].ControlSource = ""       Me![cboLastMeetingDate].Enabled = False       Me![cboLastMeetingDate].ControlSource = ""       Me![cboSalary].Enabled = True       Me![cboSalary].ControlSource = "FilterValue"       Me![cboSalary].SetFocus       Me![cboSalary].Dropdown       Me![cmdContacts].Caption = "Open Filtered Contacts Form"       Me![txtFilter].Visible = True           End Select        DoCmd.RunCommand acCmdSaveRecord    If intFilter > 1 Then       strFilter = " WHERE [ContactID] = 0"       strRecordSource = "qryContacts"       strQuery = "qryFilteredContacts"       strSQL = "SELECT * FROM " & strRecordSource & strFilter & ";"       Debug.Print "SQL Statement: " & strSQL       Debug.Print CreateAndTestQuery(strQuery, strSQL) & "records found"       Me![subSearchResults].Form.RecordSource = strQuery    End If     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub 

The Contacts command button’s Click event procedure is listed below. If the Unfiltered option is selected in the option group, the strFilter variable is set to a zero-length string; otherwise the saved filter string is picked up from the FilterString field. The Contacts form is then opened, either unfiltered or filtered by the selected filter string, and the search form is closed.

 Private Sub cmdContacts_Click() On Error GoTo ErrorHandler    Dim strFormName As String    strFormName = "frmContacts"    If Me![fraFilter].Value = 1 Then       strFilter = ""    Else       ‘Pick up saved filter string       strFilter = Me![FilterString]    End If        DoCmd.OpenForm FormName:=strFormName,        view:=acNormal,        windowmode:=acWindowNormal,        wherecondition:=strFilter    Me.Visible = False ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit     End Sub 

DblClick Event from Datasheet Subform

If you need to run an event procedure from a datasheet subform, you don’t have the usual options of a command button or option group. For datasheet subforms, I like to use the DblClick event on a textbox. The datasheet subform (fsubSearchResults) on the Dynamic Search form has a DblClick event procedure on both txtContactID and txtContactName. The txtContactName DblClick event procedure is listed below. First the code checks that a contact has been selected, and then the FilterContact Sub procedure is called, with the selected ContactID value as its argument.

 Private Sub txtContactName_DblClick(Cancel As Integer) On Error GoTo ErrorHandler        lngContactID = Nz(Me![ContactID])    If lngContactID <> 0 Then       Call FilterContact(lngContactID)    End If     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description Resume ErrorHandlerExit End Sub 

The FilterContact procedure is listed below. The code is simpler than the filter field combobox code on the main form; it just creates a filter string based on ContactID, then opens frmContacts with the filter string for its wherecondition argument.

 Private Sub FilterContact(lngID As Long) On Error GoTo ErrorHandler            Dim strFilter As String        strFilter = "[ContactID] = " & lngID    DoCmd.OpenForm FormName:="frmContacts",        view:=acNormal,        wherecondition:=strFilter     ErrorHandlerExit:    Exit Sub ErrorHandler:    MsgBox "Error No: " & Err.Number & "; Description: " &        Err.Description    Resume ErrorHandlerExit End Sub 

Figure 7.15 shows frmContacts opened for just the selected contact.

Figure 7.15