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!
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.
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.
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.
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.