Automating Complex Tasks

The most complex Visual Basic code we’ve examined thus far in this chapter is the procedure to build a search clause from the data you enter in the fdlgContactSearch form. Trust us, we’ve only started to scratch the surface!

Triggering a Data Task from a Related Form

One of the more complex pieces of code in the Conrad Systems Contacts sample database is triggered from the fsubContactEvents form that’s part of the frmContacts form. After signing on correctly to the application, the user can open the frmContacts form, click on the Events tab, and add an event indicating the sale of a product. As soon as the user saves the record, code behind the subform automatically adds the product to the contact, as shown in Figure 20–24.

Figure 20–24: Logging a product sale event on the Events tab automatically sells the product to the contact.

If you look behind the fsubContactEvents form, you’ll find event procedures that detect when the user has created a sale event and execute an SQL INSERT command to create the related product row. The code is as follows:

 Option Compare Database  Option Explicit  ' Flag to indicate auto-add of a product if new event requires it  Dim intProductAdd As Integer  ' Place to store Company Name on a product add  Dim varCoName As Variant  ' End of the Declarations Section    Private Sub ContactEventTypeID_BeforeUpdate(Cancel As Integer)    ' Did they pick an event that involves a software sale?    ' NOTE: All columns in a combo box are TEXT    If Me.ContactEventTypeID.Column(4) = "-1" Then      ' Try to lookup this contact's Company Name      varCoName = DLookup("CompanyName", "qryContactDefaultCompany", _        "ContactID = " & Me.Parent.ContactID.Value)      ' If not found, then disallow product sale      If IsNothing(varCoName) Then        MsgBox "You cannot sell a product to a Contact " & _          "that does not have a " & _          "related Company that is marked as the default for this Contact." & _          "  Press Esc to clear your edits and click on the Companies tab " & _          "to define the default Company for this Contact.", _          vbCritical, gstrAppTitle        Cancel = True      End If    End If  End Sub    Private Sub Form_BeforeUpdate(Cancel As Integer)    ' Did they pick an event that involves a software sale?    ' NOTE: All columns in a combo box are TEXT    If Me.ContactEventTypeID.Column(4) = "-1" Then      ' Do this only if on a new record or they changed the EventID value      If (Me.NewRecord) Or (Me.ContactEventTypeID <> _        Me.ContactEventTypeID.OldValue) Then        ' Set the add product flag                                                         '- product added by AfterUpdate code for safety        intProductAdd = True      End If    End If  End Sub    Private Sub Form_AfterUpdate()  Dim strSQL As String, curPrice As Currency,                                  Dim lngProduct As Long, varCoID As Variant  Dim rst As DAO.Recordset, strPreReqName As String    ' See if we need to auto-add a product    If (intProductAdd = True) Then      ' Reset so we only do this once      intProductAdd = False      ' Set an error trap      On Error GoTo Insert_Err      ' Save the Product ID      lngProduct = Me.ContactEventTypeID.Column(5)      ' Fetch the product record      Set rst = CurrentDb.OpenRecordset("SELECT * FROM tblProducts " & _        "WHERE ProductID = " & lngProduct)        ' Make sure we got a record        If rst.EOF Then          MsgBox "Could not find the product record for this sales event." & _            "  Auto-create of " & _            "product record for this contact has failed.", _            vbCritical, gstrAppTitle          rst.Close          Set rst = Nothing          GoTo Insert_Exit        End If        ' Check for prerequisite product        If Not IsNull(rst!PreRequisite) Then          ' Make sure contact owns the prerequisite product          If IsNull(DLookup("ProductID", "tblContactProducts", _            "ProductID = " & rst!PreRequisite & " And ContactID = " & _            Me.Parent.ContactID)) Then            ' Get the name of the prerequisite            strPreReqName = DLookup("ProductName", "tblProducts", _              "ProductID = " & rst!PreRequisite)            ' Display error            MsgBox "This contact must own prerequisite product " & _              strPreReqName & " before you can sell this product." & _              vbCrLf & vbCrLf & _              "Auto-create of product record for this contact has failed", _              vbCritical, gstrAppTitle            ' Bail            rst.Close            Set rst = Nothing            GoTo Insert_Exit          End If        End If        ' Save the price        curPrice = rst!UnitPrice        ' Done with the record - close it        rst.Close        Set rst = Nothing        ' Now, find the default company for this contact        varCoID = DLookup("CompanyID", "qryContactDefaultCompany", _          "ContactID = " & Me.Parent.ContactID.Value)        ' If not found, then disallow product sale        If IsNothing(varCoID) Then          MsgBox "You cannot sell a product to a Contact who does not have a " & _            "related Company that is marked as the default for this Contact.", _            vbCritical, gstrAppTitle          GoTo Insert_Exit        End If        ' Set up the INSERT command        strSQL = "INSERT INTO tblContactProducts " & _          "(CompanyID, ContactID, ProductID, DateSold, SoldPrice) " & _          "VALUES(" & varCoID & ", " & Me.Parent.ContactID & ", " & _          lngProduct & ", #" & _          DateValue(Me.ContactDateTime) & "#, " & _          curPrice & ")"      ' Attempt to insert the Product row      CurrentDb.Execute strSQL, dbFailOnError      ' Got a good add - inform the user      MsgBox "The product you sold with this event " & _        "has been automatically added " & _        "to the product list for this user.                                         " & _        "Click the Products tab to verify the price.", _        vbInformation, gstrAppTitle      ' Requery the other subform to get the new row there      Me.Parent.fsubContactProducts.Requery    End If  Insert_Exit:    Exit Sub  Insert_Err:    ' Was error a duplicate row?    If Err = errDuplicate Then      MsgBox "CSD Contacts attempted to auto-add " & _      "the product that you just indicated " & _      "that you sold, but the Contact appears " & _      "to already own this product.                                               Be sure " & _      "to verify that you haven't tried to sell the same product twice.", _      vbCritical, gstrAppTitle    Else      MsgBox "There was an error attempting to auto-add " & _        "the product you just sold: " & _        Err & ", " & Error, vbCritical, gstrAppTitle      ' Log the error      ErrorLog Me.Name & "_FormAfterUpdate", Err, Error    End If    Resume Insert_Exit  End Sub

In the Declarations section of the module, you can find two variables that the event procedures use to pass information between events. (If you declare the variables inside one of the procedures, only that procedure can use the variables.) The BeforeUpdate event procedure for the contact event type checks to see if the event is a product sale (by examining one of the hidden columns in the combo box row source). If the user is trying to log a product sale and this particular contact doesn’t have a default company defined, the code displays an error message and won’t let the user save that event type. Remember, a record in the tblContactProducts table must have a CompanyID as well as a ContactID.

When the user attempts to save a new or changed event record, Access runs the form’s BeforeUpdate event procedure. This code again checks to see if the record about to be saved is for a product sale. However, if this isn’t a new record or the user is saving an old event record but didn’t change the event type, the code exits because it doesn’t want to add a product record twice. (If this is an existing record and the event type didn’t change, this code probably created the companion contact product record the first time the user saved the record.) The code could insert the record into tblContactProducts at this point, but, as you learned in Chapter 17, the record isn’t really saved until after the BeforeUpdate event finishes. So, this code sets the module variable to tell the form’s AfterUpdate event procedure to perform that task after Access has saved the changed record.

After Access saves the new or changed event record, it runs the form’s AfterUpdate event procedure. If the code in BeforeUpdate indicated that a product insert is required by setting the module intProductAdd variable to True, this code sets up to add the new record. It opens a recordset on the tblProducts table for the product that was just sold so that it can get the product price and check for any prerequisite product. If the product has a prerequisite but this contact doesn’t own the prerequisite, the code displays an error message and exits.

Although previous code checked to see that this contact has a default CompanyID, this code checks again and exits if it can’t find one. After the code has completed all checks and has the price and company ID information it needs, it inserts the new record into the tblContactProducts table using SQL. Notice that at the bottom of the procedure you can find error-trapping code that tests to see if the insert caused a duplicate record error.

Linking to a Related Task

Let’s switch to the Housing Reservations application (Housing.accdb) and take a look at the process for confirming a room for a reservation request. To see this in action, you must start the application by opening the frmSplash form, and then sign on as an administrator (Conrad, Jeff, Richins, Jack Schare, Gary, or Viescas, John L.) using password as the password. On the main switchboard, click Reservation Requests, and then click View Unbooked in the Edit Reservation Requests dialog box. You’ll see the Unbooked Requests form (frmUnbookedRequests) as shown in Figure 20–25.

Note 

The query that provides the records displayed in the frmUnbookedRequests form includes criteria to exclude any requests that have a check-in date earlier than today’s date. (It doesn’t make sense to confirm a reservation request for a date in the past.) The latest requested check-in date in the original database is September 15, 2007, so you will probably see an error message when you attempt to look at unbooked requests. You can use the zfrmLoadData form to load new reservations and requests that are more current into the qryUnbookedRequests query to not eliminate old requests to be able to see how the frmUnbookedRequests form works.

Figure 20–25: The Unbooked Requests form lets administrators view pending requests and start the booking process.

Earlier in this chapter, in “Linking to Related Data in Another Form or Report” on page 1098, you learned one technique for using a command button to link to a related task. The key task in the Housing Reservations application for the housing manager (or any administrator) is to assign a room and book a reservation for pending requests. When you click one of the Book buttons on the Unbooked Requests form, code behind the form opens a form to show the manager the rooms that match the request and aren’t booked for the time span requested. If you click the request from Kirk DeGrasse for a room with a king bed from June 7, 2007, to June 25, 2007, you’ll see the list of available rooms in the fdlgAvailableRooms form as shown in Figure 20–26.

Figure 20–26: The fdlgAvailableRooms form shows a list of available rooms matching the selected reservation request.

The code behind the Book button on the frmUnbookedRequests form is as follows:

 Private Sub cmdBook_Click()    ' Make sure no changes are pending    If Me.Dirty Then Me.Dirty = False    ' Open the available rooms form - hidden, dialog    '  and check if any available    DoCmd.OpenForm "fdlgAvailableRooms", _      WhereCondition:="Smoking = " & Me.Smoking, _      WindowMode:=acHidden    If Forms!fdlgAvailableRooms.RecordsetClone.RecordCount = 0 Then      MsgBox "There are no available rooms of this " & _        "type for the dates requested." & _        vbCrLf & vbCrLf & _        "You can change the Room Type or dates and try again.", _        vbInformation, gstrAppTitle      DoCmd.Close acForm, "fdlgAvailableRooms"      Exit Sub    End If    ' Show the available rooms     ' - form will call our public sub to create the res.    Forms!fdlgAvailableRooms.Visible = True  End Sub

The record source of the fdlgAvailableRooms form is a parameter query that filters out rooms already booked for the specified dates and includes the remaining rooms that match the requested room type. The code behind the Book button adds a filter for the smoking or nonsmoking request because the room type doesn’t include this information but each specific available room does. Behind the Pick This button on the fdlgAvailableRooms form, you can find the following code:

 Private Sub cmdPick_Click()  Dim intReturn As Integer    ' Call the build a reservation proc in the calling form    intReturn = Form_frmUnbookedRequests.Bookit(Me.FacilityID, Me.RoomNumber, _      Me.DailyRate, Me.WeeklyRate)    If (intReturn = True) Then      MsgBox "Booked!", vbExclamation, gstrAppTitle    Else      MsgBox "Room booking failed.  Please try again.", _        vbCritical, gstrAppTitle    End If    DoCmd.Close acForm, Me.Name  End Sub

Can you figure out what’s happening? Back in frmUnbookedRequests, there’s a public function called Bookit that this code calls as a method of that form. It passes the critical FacilityID, RoomNumber, DailyRate, and WeeklyRate fields to complete the booking. Back in frmUnbookedRequests, the code in the public function is as follows:

 Public Function Bookit(lngFacility As Long, lngRoom As Long, _    curDaily As Currency, curWeekly As Currency) As Integer  ' Sub called as a method by fdlgAvailableRooms to book the selected room  ' Caller passes in selected Facility, Room number, and rates  Dim db As DAO.Database, rstRes As DAO.Recordset  Dim varResNum As Variant, strSQL As String, intTrans As Integer    ' Set error trap    On Error GoTo BookIt_Err    ' Get a pointer to this database    Set db = CurrentDb    ' Open the reservations table for insert    Set rstRes = db.OpenRecordset("tblReservations", _      dbOpenDynaset, dbAppendOnly)    ' Start a transaction    BeginTrans    intTrans = True    ' Get the next available reservation number    varResNum = DMax("ReservationID", "tblReservations")    If IsNull(varResNum) Then varResNum = 0    varResNum = varResNum + 1    ' Update the current row    strSQL = "UPDATE tblReservationRequests SET ReservationID = " & _      varResNum & " WHERE RequestID = " & Me.RequestID    db.Execute strSQL, dbFailOnError    ' Book it!    rstRes.AddNew    ' Copy reservation ID    rstRes!ReservationID = varResNum    ' Copy employee number    rstRes!EmployeeNumber = Me.EmployeeNumber    ' Copy facility ID from the room we picked    rstRes!FacilityID = lngFacility    ' .. and room number    rstRes!RoomNumber = lngRoom    ' Set reservation date = today    rstRes!ReservationDate = Date    ' Copy check-in, check-out, and notes    rstRes!CheckInDate = Me.CheckInDate    rstRes!CheckOutDate = Me.CheckOutDate    rstRes!Notes = Me.Notes    ' Copy daily and weekly rates    rstRes!DailyRate = curDaily    rstRes!WeeklyRate = curWeekly    ' Calculate the total charge    rstRes!TotalCharge = ((Int(Me.CheckOutDate - Me.CheckInDate) \ 7) * _      curWeekly) + _      ((Int(Me.CheckOutDate - Me.CheckInDate) Mod 7) * _      curDaily)    ' Save the Reservation Row    rstRes.Update    ' Commit the transaction    CommitTrans    intTrans = False    ' Clean up    rstRes.Close    Set rstRes = Nothing    Set db = Nothing    ' Requery this form to remove the booked row    Me.Requery    ' Return success    Bookit = True  BookIt_Exit:    Exit Function  BookIt_Err:    MsgBox "Unexpected Error: " & Err & ", " & Error, vbCritical, gstrAppTitle    ErrorLog Me.Name & "_Bookit", Err, Error    Bookit = False    If (intTrans = True) Then Rollback    Resume BookIt_Exit  End Function

It makes sense to have the actual booking code back in the frmUnbookedRequests form because the row the code needs to insert into tblReservations needs several fields from the current request record (EmployeeNumber, CheckInDate, CheckOutDate, and Notes). The code starts a transaction because it must simultaneously enter a ReservationID in both the tblReservationRequests table and the tblReservations table. If either fails, the error-trapping code rolls back both updates. Notice that the code opens the tblReservations table for append only to make the insert of the new reservation more efficient.

Calculating a Stored Value

If you follow the rules of good table design (see Article 1, “Designing Your Database Application”), you know that storing a calculated value in a table isn’t usually a good idea because you must write code to maintain the value. But sometimes, in a very large database, you need to calculate and save a value to improve performance for searching and reporting. The Housing Reservations application isn’t all that large-but it could be in real life. We chose to store the calculated total charge for each reservation to show you some of the steps you must take to maintain a value like this.

Users can create and edit reservation requests, but the creation of the reservation records that contain the calculated value is controlled entirely by code, so maintaining the calculated TotalCharge value in this application is simple. You’ve already seen the one place where a new reservation record is created-in the public Bookit function in the frmUnbookedRequests form. The little piece of code that calculates the value is as follows:

 ' Calculate the total charge  rstRes!TotalCharge = ((Int(Me.CheckOutDate - Me.CheckInDate) \ 7) * _    curWeekly) + _    ((Int(Me.CheckOutDate - Me.CheckInDate) Mod 7) * _    curDaily)

However, in many applications, you may not be able to control the editing of a calculated value this closely. You need to carefully consider the ramifications of saving a calculated value in your table and perhaps write code that an administrator can run to periodically verify that any saved calculated value hasn’t become out of sync with the other fields used to perform the calculation.