| It's not always desirable to return data to a worksheet from a database. Particularly when there are many fields that you want the user to see, to edit or to otherwise respond to, you should consider putting the data in a user form. You establish a user form by switching to the Visual Basic Editor and choosing UserForm from the Insert menu. With an empty form active, you can use the Control Toolbox to place controls text boxes, combo boxes, option buttons, multi-page controls, command buttons, and so on on your form. A multi-page control is useful when you have too many fields to conveniently fit on a normal user form. When you put a multi-page control on a form, you establish two or more tabs. Each tab has a different set of controls, very much like the dialog box that appears when you choose Options from Excel's Tools menu. The main tab of the user form that is used in conjunction with the Reservations application appears in Figure 11.3. The user employs the form to supply data about a new reservation or to change data about an existing reservation. Figure 11.3. By enclosing the two option buttons Hold and Reserve in the same frame, labeled Action, you make them mutually exclusive. 
When the user is making a new reservation, he chooses options and enters information on a blank user form. When he clicks the OK button, code gets the data from the user form and stores it in the database. When the user is editing an existing reservation, information about the reservation is first obtained from the database and written to the user form. The user then can modify the value of any controls he wants. When he clicks OK, the code once again gets the data from the user form and puts it in the database. Identifying the Reservation Record The following code runs when the user has indicated that he wants to edit an existing reservation. It moves data from the database to the user form. The user begins by clicking any cell on the worksheet that represents a reservation, and then chooses a custom menu item that causes this procedure to run. Sub FromDBtoForm(rsRecordsToEdit As Recordset) Dim i As Integer Dim ResourceCount As Integer Dim WhichDate As Date, StartTime As Date Dim WhichRoom As String Dim WhichColumn As Integer Dim qdfEditDetails As QueryDef Dim rsRecordsToEdit As Recordset DatabaseName = ThisWorkbook.Sheets("UserNames").Cells(1, 3) Set dbReservation = OpenDatabase(DatabaseName, False, False, "MS Access")
After identifying the location and the name of the reservations database, it's opened and assigned to the object variable dbReservation. Now the code needs to retrieve from the database all the fields that describe the reservation the user has chosen to edit. Begin by collecting from the worksheet the information necessary to uniquely identify a reservation in the database: the date, the room, and the start time. Only one reservation can exist on a given date, in a given room, and commencing at a given start time. WhichDate = ActiveSheet.Name WhichRoom = ActiveSheet.Cells(ActiveCell.Row, 1).Value
The reservation's date is stored as the active sheet's name, which is also shown on the sheet tab. Because the user starts the process by clicking one of the cells that represents the reservation, the room that's reserved is shown in column A of the active cell's row. The sheet name is stored in WhichDate and the room name is stored in WhichRoom. It remains to determine the reservation's start time. The user is allowed to begin this process by clicking any cell in the range that represents a reservation. Recall that the cells in the reservation range each contain a string that names the meeting CASE MGMT TRAINING, for example. To find the leftmost cell for the reservation, all that's needed is to keep moving left from the active cell until a cell is found that does not contain the meeting's name. The leftmost cell that does contain the meeting's name is in the column that represents the reservation's start time. So, identify the number of the column to the left of the active cell. WhichColumn = ActiveCell.Column - 1
Use a Do loop to decrement the value of WhichColumn until the value of the cell in WhichColumn no longer equals the value in the active cell. Do While Cells(ActiveCell.Row, WhichColumn) = _ Cells(ActiveCell.Row, ActiveCell.Column) WhichColumn = WhichColumn - 1 Loop
The start time for the reservation is found in row 1 of the prior value of WhichColumn. Store the start time in the StartTime variable. StartTime = ActiveSheet.Cells(1, WhichColumn + 1).Value
Now set the query that will return all the information about the selected reservation from the database, and pass the values of the reservation date, the reserved room, and the start time as parameters to the query. Set qdfEditDetails = dbReservation.QueryDefs("DetailRecords") With qdfEditDetails .Parameters("WhichDate") = WhichDate .Parameters("WhichRoom") = WhichRoom .Parameters("WhichTime") = StartTime
Then set the object variable rsRecordsToEdit to the result of executing the query with its parameters. Set rsRecordsToEdit = .OpenRecordset(dbOpenForwardOnly) End With
Figure 11.4 shows the query in design view. Figure 11.4. By including the Resources table, the code can use the room name instead of its ID as a parameter. 
To review: The user has clicked a cell in an existing reservation on the Excel worksheet, and selected a custom menu item that calls the present procedure. The code notes the name of the worksheet (to get the reservation date), the name of the reserved room, and the column in which the reservation starts (to get its start time). These values are passed as parameters to a database query. Together they specify a single reservation. That reservation's record is assigned to the object variable rsRecordsToEdit, and the next general step is to populate the user form with the reservation's information. Populating the User Form The values retrieved from the database are now assigned to the controls on the user form. Because the user form is involved in many of the assignment statements, a With block is initiated. Subsequently, objects that are used and that begin with a dot are deemed to belong to the With statement's object, the user form itself. With ReservationForm
Now you need to populate the list box that shows the available rooms. It's handled a little differently from the date, the start time, and the stop time combo boxes. The reason is that the list of available rooms can change from time to time as one room becomes unavailable for meetings or a new room is added. In contrast, the number of available 15-minute periods, and their designations, are constants, as are the days in the year. Because dates and times are constants, their combo boxes can use static worksheet ranges as their data sources. But because the list of available rooms can change unexpectedly, it's desirable to rebuild the contents of the list box each time the form is displayed. Start by getting the number of rooms available from column A. ResourceCount = ActiveSheet.Cells(600, 1).End(xlUp).Row - 1
Clear the current entries in the room list box. Then loop through the list of rooms on the active worksheet and populate the list box. .lbResources.Clear For i = 2 To ResourceCount .lbResources.AddItem (ActiveSheet.Cells(i, 1)) Next i
The database stores the reserved room as a numeric ID, not as the room's name. So, the code picks up the name of the reserved room from the worksheet and uses it to set the room list box's current selection. .lbResources = ActiveSheet.Cells(ActiveCell.Row, 1)
TIP A list box can have its MultiSelect property set to a multiple selection. In this way, a user can select more than one of the items in the list. If you set that property to fmMultiSelectMulti, you must work with the list box's list index. For example, if it were possible to select more than one room in the list box, you would show that those rooms had been selected by setting the Selected property for that item to True. For example, to select both the 11th and the 13th items in a multi-select list box, use this: .lbResources.Selected(10) = True .lbResources.Selected(12) = True
NOTE In each case, 1 is subtracted from the calculated value of the ListIndex because the first element of the combo box's list is element number 0. This is unaffected by the use of Option Base 1. The same is true for the room list box, although it's the Selected property rather than the ListIndex property that's set.
Now set the combo boxes (informally known as dropdowns) to their proper values. The combo boxes display the reservation date and the start and stop times. The code sets the value of the combo boxes directly from the values of the fields in the recordset. .cbDate = rsRecordsToEdit.Fields("ReservationDate") .cbStartTime = rsRecordsToEdit.Fields("StartTime") .cbStopTime = rsRecordsToEdit.Fields("StopTime")
Understanding the Combo Box A combo box is perhaps more familiarly termed a dropdown. The combo box combines a text box with a list box. The text box is normally visible and shows the item that has been selected. The list box appears, or drops down, when you click its arrow. Using VBA code, you can set the value of a combo box in one of two ways. Either assign the value directly to the combo box (the approach used in the code described here) or set its ListIndex property. The ListIndex is the number of the item in the list box (starting with 0, not 1). If you assign a value directly, it need not be a member of the list, and the value of ListIndex is set to 1. The first element of the combo box's list is element number 0. Thus, if you want to set the value of the combo box to its 15th element, you would use something like ReservationForm.cbDate.ListIndex = 14
This is unaffected by the use of Option Base 1. The same is true for a pure list box. |
Suppose that you want a combo box to display the value 7:00 AM. You could use a statement such as this: cbStartTime = "7:00 AM"
Alternatively, you could set the combo box's ListIndex property. Assuming that 7:00 AM is the third value in the list, you would use this (remember, the first item in a list box is item number 0): ReservationForm.cbStartTime.ListIndex = 2
The possible values for the three combo boxes are stored in a hidden worksheet, UserNames. (This is the same worksheet that stores the path to and name of the reservations database.) The worksheet is shown in Figure 11.5. Figure 11.5. If you store values to be used by code in a sheet, it's a good idea to set the sheet's Visible property to xlVeryHidden. 
Compared to the choices involved in setting the values of list boxes and combo boxes, it's very straightforward to set the value of text boxes such as those that display the number of setup periods and cleanup periods. Just set the text box equal to the value you want it to display. .tbSetupPeriods = rsRecordsToEdit.Fields("SetupPeriods") .tbCleanupPeriods = rsRecordsToEdit.Fields("CleanupPeriods") .tbPurposeBox.Value = rsRecordsToEdit.Fields("Purpose") .tbReservedForBox.Value = rsRecordsToEdit.Fields("ReservedFor")
Of course, you can set values on the user form conditionally. Here, one option button or another gets set to True depending on the value of a field in the recordset. If rsRecordsToEdit.Fields("Participants") = "Internal" Then .obInternal.Value = True ElseIf rsRecordsToEdit.Fields("Participants") = "External" Then .obExternal.Value = True End If
About 300 lines of code are omitted at this point. Their purpose is to set the values of other controls on the user form, controls that do not appear in Figure 11.5 because they're located on different tabs. The approach used is the same as this section has illustrated: Assign to a control the value found in the recordset, in the field that's associated with the control. Just to finish the controls on the form's main tab, the responsible department and the account to be charged are set: .cbDept.Value = rsRecordsToEdit.Fields("Department") .tbAccount.Value = rsRecordsToEdit.Fields("Account") End With Set dbReservatioons = Nothing Set rsRecordsToEdit = Nothing End Sub
The With block is terminated, object variables are released, and the subroutine itself is ended. Allowing for Recurring Reservations One particularly useful aspect of the design of this reservations application is its capability to deal with recurring reservations. From the user's standpoint, a recurring reservation represents a meeting that occurs more than once, usually on a regular basis, in the same room, and with the same room setup requirements. For example, the user might make all the necessary arrangements for a meeting reservation and, in addition, request that those same arrangements apply to other dates. The other dates might be every other Wednesday, or the third weekday in every month, or on each day for five consecutive days. From the application's standpoint, a recurring reservation consists of at least two records that share the same MasterID. In brief here's how individual reservations are grouped into a set of recurring reservations.  For more information on moving data from a workbook to a database, see "Using DAO Recordsets to Move Data from Excel to a Jet Database," p. 337.
The database contains a table, named Masters, whose sole purpose is to provide a new master ID for each reservation. The table has an AutoNumber field named MasterID. When the user establishes a new reservation, recurring or not, these statements are among the code that runs: Sub GetMasterID(dbReservation As Database, _ MasterResID As Long) Dim rsMasterTable As Recordset Set rsMasterTable = dbReservation.TableDefs("Masters") _ .OpenRecordset(dbOpenDynaset) With rsMasterTable .AddNew .Update .MoveLast MasterResID = .Fields("MasterID") .Close End With Set rsMasterTable = Nothing End Sub
A new record is added to the table named Masters. When this is done, a new, unique value is automatically placed in the AutoNumber field MasterID. That value is assigned to the variable MasterResID. NOTE Notice that MasterResID is passed to the GetMasterID subroutine as a Long that is, as a long integer. AutoNumber fields in Access are by default long integers, so it's best to give MasterResID the same variable type.
Milliseconds later, when the information about the reservation is stored in the database, the new reservation record stores the value of MasterResID: rsReservation.Fields("MasterID") = MasterResID
Using that arrangement, when a user wants to edit a reservation or even delete it the code can obtain all the related, recurring reservations and at the user's option, apply the changes to all of them or only to the one that the user began by selecting. Deleting Records from the Database and from the Worksheet Here's how it works out in practice. Suppose that the user has clicked a cell in an existing reservation on the Excel worksheet, and chosen a custom menu item that initiates the cancellation of the reservation. It's necessary to take care of two broad tasks: indicating to the database that the reservation (or, if recurring, the reservations) has been cancelled, and removing the reservation from the worksheet, so that the room will be available for some other use on that day and at that time. The following code manages those tasks. Managing the Preliminaries As usual, the procedure begins with a Sub statement and the declaration of the necessary variables. Sub RemoveReservation()
It's good to check to make sure that the user has selected a cell in the reservation range before attempting to remove it. Such a cell has been colored either red to represent a firm reservation or yellow to represent a temporary hold. The CellColor variable is used to determine whether the user has started by selecting a cell in that range. Dim CellColor As Integer
Three variables are declared to uniquely identify the reservation in question. As noted in the prior section, only one record can have a particular date, start time, and room. By determining their values for the reservation that the user wants to cancel, the code can find that specific reservation in the database and take the appropriate action. They are declared as WhichDate, WhichRoom, and StartTime. Dim WhichDate As Date, WhichRoom As String, StartTime As Date
WhichColumn is used as in the prior section to help determine the reservation's start time. Dim WhichColumn As Integer
It's best, after the reservation's record has been found but before actually canceling it, to ask the user whether he's sure he wants to go ahead. The Confirm variable is used to capture that information. Dim Confirm As Integer
Two recordsets are declared: one to represent the Reservations table and one to associate the IDs that identify rooms with the names of the rooms. Dim rsReservation As Recordset, rsRooms As Recordset
Two Long integers are declared, one to hold the reservation's master ID the one that it shares with other records that are part of the same recurrence group and a record ID that uniquely identifies one particular reservation. Dim MasterResID As Long, RecordID As Long
Two object variables are used to represent database objects. The query that returns the reservation record (or records) is qdfEditDetails, and the recordset that holds the record (or records) is rsRecordsToDelete. Dim qdfRecordDetails As QueryDef Dim rsRecordsToDelete As Recordset
The next two variables required will contain the number of reservation records in the recordset: one if the reservation is nonrecurring, and an initially unknown number of records otherwise. Lastly, ResourceID is used to store the ID number that identifies a particular room. Dim ReservationCount As Long Dim ResourceID As Long
Four variables are declared to support communication with the user via a message box. The Msg variable stores the message itself, the Style variable contains an integer that determines the mix of buttons in the message box (for example, OK only, Yes/No/Cancel, and so on), Title to hold the string that's shown in the message box's title bar, and Response to capture the user's response to the message box. Dim Msg As String, Style As Integer, Title As String, _ Response As Integer
Verifying and Confirming the User's Request The code then makes sure that the user has begun by selecting a cell within an existing reservation. A cell that represents a reservation has its color set to yellow (for a temporary hold) or to red (for a firm reservation). The code would not work properly if the user had not begun by identifying a reservation, so the code checks to see whether the cell's color is either yellow or red. The code determines the numeric index that identifies the active cell's color 3 for red, 6 for yellow. If it is neither 3 nor 6, it displays a message box, complaining that the user has not selected a reservation cell. Then the subroutine is exited so that no more of its code runs. CellColor = ActiveCell.Interior.ColorIndex If CellColor <> 6 And CellColor <> 3 Then MsgBox "To remove a reservation, please begin by selecting a cell " _ & "that's part of an existing reservation -- that is, a red " _ & "cell or a yellow cell." Exit Sub End If
The arguments for this message box do not call for a particular set of command buttons. Therefore VBA displays the default, which is a single OK button. Regardless of what the user does to dismiss the message box, the code then stops processing. Assuming that the user began by selecting a reservation, the code next confirms that the user really does want to delete it. VBA displays a message box that asks the user if he's sure. The vbOKCancel argument causes the message box to have an OK button and a Cancel button. Confirm = MsgBox("Are you sure you want to " _ & "delete this reservation?", vbOKCancel)
If the user clicks the Yes button, indicating that he wants to go ahead and delete the reservation, the message box returns a 1. So, if it returns anything else, the code stops processing by means of the Exit Sub statement. If Confirm <> 1 Then Exit Sub End If
Otherwise, the code continues by finding the path to and name of the reservations database, and opening it. DatabaseName = ThisWorkbook.Sheets("UserNames").Cells(1, 3) Set dbReservation = OpenDatabase(DatabaseName, False, False, "MS Access")
Establishing the Recordsets Two recordsets are established. The database's Reservations table is needed because the reservation record needs to be deleted from that table. The Resources table is needed so that the code can determine the ID of the room that's been reserved. (The worksheet shows the names of the rooms, but the Reservations table stores their IDs rather than their names.) Set rsReservation = dbReservation.TableDefs _ ("Reservations").OpenRecordset(dbOpenDynaset) Set rsRooms = dbReservation.TableDefs _ ("Resources").OpenRecordset(dbOpenDynaset)
Finding the Reservation in the Database It's time to get the information from the worksheet that will uniquely identify the reservation that the user selected. As noted in the "Identifying the Reservation Record" section, that information includes the reservation's date, its room, and its start time. The date and the time are obtained in precisely the same way they were in "Identifying the Reservation Record." It gets the active sheet name for the date. It gets the start time by backing up to the beginning of the reservation range to find its starting column the start time is in row 1 of that column. WhichDate = ActiveSheet.Name WhichColumn = ActiveCell.Column - 1 Do While Cells(ActiveCell.Row, WhichColumn) = _ Cells(ActiveCell.Row, ActiveCell.Column) WhichColumn = WhichColumn - 1 Loop StartTime = ActiveSheet.Cells(1, WhichColumn + 1).Value
In this case, though, it's more convenient to use the room's ID rather than its name. But that ID has to be obtained by using the room's name, and another subroutine, a brief one, is used to do that. The room's name is obtained as before from column A of the reservation's row. WhichRoom = ActiveSheet.Cells(ActiveCell.Row, 1).Value ConvertResource WhichRoom, ResourceID, rsRooms
Then the ConvertResource subroutine is called, with the room's name (WhichRoom), a variable to hold its ID (ResourceID), and the recordset that contains the names and IDs of rooms (rsRooms) as arguments. As yet, ResourceID has no value, but when it's returned from ConvertResource it will contain the ID of the selected room. Here's the code for that procedure: Sub ConvertResource(RoomName As String, _ ResourceID As Long, rsRooms As Recordset) Dim Criterion As String Criterion = "ResourceName = '" & RoomName & "'" With rsRooms .FindFirst Criterion ResourceID = .Fields("ResourceID") End With End Sub
The FindFirst method is used to locate the selected room name in the Resources table, represented by the rsRooms recordset. The code stores in Criterion a string comprised of the name of the field to be searched, ResourceName, and the name of the room to be found, stored in RoomName. Suppose that the name Cafeteria is in RoomName. The search string, Criterion, would be ResourceName = 'Cafeteria'
The record with the value from RoomName in the ResourceName field is found, and its value on the ResourceID field is stored in the ResourceID variable. That variable is then returned to the calling procedure, RemoveReservation. TIP This code does not use the NoMatch property because the remainder of the application guarantees that a record will be found. If you use a search method such as FindFirst or Seek, consider using NoMatch. This property is True if the search method failed to find a record corresponding to the search criteria. For example, rsRooms.FindFirst Criterion If rsRooms.NoMatch Then [Code to recover from a failure to find a record] End If
You could also use something such as If Not rsRooms.NoMatch to enable your code to continue processing. (The double negative does take a little getting used to.)
Checking for Recurring Reservations Now that the room's ResourceID has been located, the code in the RemoveReservation subroutine continues. It first checks to see whether the record's MasterID is shared by any other records that is, it checks whether the selected reservation is a recurring one. It does this by calling the function FindReservationMasterIDInDB, using the reservation database, the reservation date, the room ID, and the start time as arguments. MasterResID = FindReservationMasterIDInDB _ (dbReservation, WhichDate, ResourceID, StartTime)
The function is not built-in, but is a user-defined function, or UDF. Here is its code. Function FindReservationMasterIDInDB(dbReservation As Database, _ WhichDate As Date, WhichRoom As Long, StartTime As Date) As Long
Notice that the procedure's declaration begins with Function instead of Sub (procedure is a generic term for either a function or a subroutine). Also note that the function has a type; here, it's Long, so the value it returns is typed as a Long Integer. Two object variables are declared in the function, a query that will return all records that share the same MasterID, and a recordset that will contain those records. Dim qdfDetail As QueryDef Dim rsDetail As Recordset Set qdfDetail = dbReservation.QueryDefs("FindSingleReservation")
The query named FindSingleReservation appears in design view in Figure 11.6. Figure 11.6. Notice the calculated field, which formats StartTime as Medium time (hh:mm AM/PM). 
The code passes the room, the date, and the start time (formatted as Medium time) to the query, and its results are assigned to the recordset. With qdfDetail .Parameters("WhichRoom") = WhichRoom .Parameters("WhichDate") = WhichDate .Parameters("WhichTime") = Format(StartTime, "Medium Time") Set rsDetail = .OpenRecordset(dbOpenDynaset) End With
Then the function itself is set to the value of the MasterID field in the recordset. With that value available, it will be possible to find out whether there are other records in the database that share the same MasterID. If there are, the code will ask the user whether they should all be deleted, or just the one that was selected when the user initiated the process. NOTE The assignment of a value to the function is typical of UDFs and of functions in general. This aspect is what enables you to write your own functions in VBA and have them return values directly to the worksheet.
FindReservationMasterIDInDB = rsDetail.Fields("MasterID") Set qdfDetail = Nothing Set rsDetail = Nothing End Function
Now the variable MasterResID has been set equal to the MasterID of the selected reservation. That value is passed as a parameter to the query named DetailRecords. The query will return only one record the one chosen by the user if it is not part of a group of recurring reservations. If the reservation does recur, the query will select all of them, and the code will ask the user whether he wants to delete all the reservations or only the one he selected. The query is assigned to an object variable and its parameter is passed. Then the query's results are assigned to a recordset. Set qdfRecordDetails = dbReservation.QueryDefs("DetailRecords") qdfRecordDetails.Parameters("WhichID") = MasterResID Set rsRecordsToDelete = qdfRecordDetails.OpenRecordset(dbOpenDynaset)
With the recordset established, go to its final record and then obtain the record count. It's necessary to first move to the final record: In a DAO recordset, the record count isn't available until the final record has been reached. Therefore, the code employs the MoveLast method on the recordset and then obtains the count of the number of records. With rsRecordsToDelete .MoveLast ReservationCount = .RecordCount End With
Now the code determines what to do if there is more than one reservation in the recordset. If ReservationCount > 1 Then
If there are multiple records that share the same MasterID, a message box is prepared. The question to be posed to the user is assembled into the string variable Msg, which asks the user whether to delete all recurring reservations or only the selected reservation: Msg = "This reservation is one of a recurring group " & _ "or a multi-room group. " & vbLf & _ "Do you want to delete all the records as a group? " & _ vbLf & "(If you click No, you will delete only " & _ "the reservation you selected.)"
The vbLf is a constant that represents a linefeed character. It's used here to break the message into three separate lines. The message box will offer a Yes, a No, and a Cancel button. This combination is specified by the vbYesNoCancel keyword and stored in the Style variable. A title is established, and the message box displayed. Style = vbYesNoCancel Title = "Delete multiple reservations"
The Response variable captures which button the user clicks. Response = MsgBox(Msg, Style, Title)
If the user clicks the Cancel button, exit this subroutine. If Response = vbCancel Then Exit Sub
If the user clicks the No button, that means he wants to delete only the selected reservation, and none of its related records. In that case, close the recordset that contains multiple records and re-establish it with only the selected record. ElseIf Response = vbNo Then rsRecordsToDelete.Close RecordID = FindReservationDetailIDInDB _ (dbReservation, WhichDate, ResourceID, StartTime)
The function FindReservationDetailIDInDB is identical to the function FindReservationMasterIDInDB, discussed earlier in this section, except that it is set equal to the ID of the selected reservation, not to its MasterID. That reservation ID is passed as a parameter to a query that returns the single reservation record, and that query's results are assigned to the rsRecordsToDelete recordset. Set qdfRecordDetails = dbReservation.QueryDefs _ ("FindOneRecord") qdfRecordDetails.Parameters("WhichID") = RecordID Set rsRecordsToDelete = qdfRecordDetails _ .OpenRecordset(dbOpenDynaset) End If End If
To recap: If the user wants to delete all of a group of recurring reservations, he indicates that by clicking the Yes button in the message box, and the rsRecordsToDelete recordset remains as it was. If he wants to delete only the selected reservation, he clicks the No button in the message box. In that case, the reservation's unique record ID is found using its date, room, and start time, and that record is used to populate the rsRecordsToDelete recordset. The code then loops through the recordset and sets the value of the Cancelled field to True for each record. With that field set, a record will not subsequently be returned to the workbook. Note the use of the Edit and the Update methods: With rsRecordsToDelete .MoveFirst Do While Not .EOF .Edit .Fields("Cancelled") = True .Update .MoveNext Loop End With
Finishing Up It remains to remove the reservation that was originally selected from the worksheet. That can be done easily by calling the GetSingleDayFromDB subroutine, discussed earlier in this chapter in the "Bringing Data Back from a Parameterized Query" section. Recall that the subroutine clears the worksheet and then retrieves all reservations for the date shown on the worksheet tab. But it does not retrieve any record for which the Cancelled field is True, so the deleted reservation does not reappear on the worksheet. GetSingleDayFromDB
Finally, clean up by releasing the object variables. Set rsReservation = Nothing Set rsRooms = Nothing Set qdfRecordDetails = Nothing Set rsRecordsToDelete = Nothing End Sub
This subroutine employs a variety of techniques that you'll find useful in returning information from a database via a recordset. It calls other subroutines that modify the value of variables, as well as a UDF that finds record IDs. It uses queries to return specific records by means both of parameters passed to the queries as well as fixed criteria (such as the Cancelled field in the GetSingleDayFromDB subroutine). It shows you how to use information in the workbook in this instance, the date from the worksheet tab, room names from column A, and times of day from row 1 to determine the records that are returned from the database. It also demonstrates how to revise the contents of recordsets based on user responses to questions posed in message boxes. This section concludes by providing you all the code it has discussed, unencumbered by commentary. The Full Code Sub GetSingleDayFromDB(Optional DateLastModified As Date) Dim dbReservation As DAO.Database Dim qdfRetrieveCurrent As DAO.QueryDef Dim rsRecordsToRetrieve As DAO.Recordset Dim StartCol As Integer, StopCol As Integer, WhichRow As Integer Dim ReservationRange As Range Dim SetupPeriods As Integer, CleanupPeriods As Integer Dim TimeAsText As String Dim TimeArray(71) As String, RoomArray() As String Dim i As Integer Dim ResourceCount As Integer ResourceCount = ActiveSheet.Cells(600, 1).End(xlUp).Row - 1 ReDim RoomArray(ResourceCount) DatabaseName = ThisWorkbook.Sheets("UserNames").Cells(1, 3) Set dbReservation = OpenDatabase(DatabaseName, False, _ False, "MS Access;PWD=Nirmac") Set qdfRetrieveCurrent = dbReservation.QueryDefs("RetrieveSingleDay") Application.ScreenUpdating = False qdfRetrieveCurrent.Parameters("ThisDate") = ActiveSheet.Name Set rsRecordsToRetrieve = qdfRetrieveCurrent.OpenRecordset(dbOpenForwardOnly) ActiveSheet.Range(Cells(2, 2), Cells(ResourceCount + 1, 73)).Clear ActiveSheet.Range(Cells(2, 2), Cells(ResourceCount + 1, 73)) _ .Interior.ColorIndex = xlNone If Not rsRecordsToRetrieve.BOF Then For i = 1 To 71 TimeArray(i) = Application.Text(ActiveSheet.Cells(1, i + 1), "h:mm AM/PM") Next i For i = 1 To ResourceCount RoomArray(i) = ActiveSheet.Cells(i + 1, 1) Next i With rsRecordsToRetrieve Do While Not .EOF TimeAsText = Application.WorksheetFunction.Text _ (.Fields("StartTime"), "h:mm AM/PM") StartCol = Application.Match(TimeAsText, TimeArray, 0) + 1 TimeAsText = Application.WorksheetFunction.Text _ (.Fields("StopTime"), "h:mm AM/PM") StopCol = Application.Match(TimeAsText, TimeArray, 0) WhichRow = Application.Match(.Fields("ResourceName"), _ RoomArray, 0) + 1 Set ReservationRange = ActiveSheet.Range(Cells(WhichRow, _ StartCol), Cells(WhichRow, StopCol)) ReservationRange.FormulaR1C1 = UCase(.Fields("Purpose")) If .Fields("ReserveHold") = "Reserve" Then ReservationRange.Interior.ColorIndex = 3 Else ReservationRange.Interior.ColorIndex = 6 End If SetupPeriods = .Fields("SetupPeriods") CleanupPeriods = .Fields("CleanupPeriods") If SetupPeriods > 0 Then ReservationRange.Offset(0, -SetupPeriods).Resize _ (1, SetupPeriods).Interior.ColorIndex = 48 End If With ReservationRange.Offset(0, -SetupPeriods) _ .Resize(1, 1).Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThick .ColorIndex = 1 End With If CleanupPeriods > 0 Then ReservationRange.Offset(0, ReservationRange.Columns.Count) _ .Resize(1, CleanupPeriods).Interior.ColorIndex = 48 End If With ReservationRange.Offset(0, ReservationRange.Columns.Count _ + CleanupPeriods - 1).Resize(1, 1).Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThick .ColorIndex = 1 End With DateLastModified = .Fields("MostRecentlyModified") ReservationRange.Resize(1, 1).ClearComments ReservationRange.Resize(1, 1).AddComment ("Reserved By: " & _ .Fields("ReserverName") & Chr(10) & "Reserved For: " & _ .Fields("ReservedFor") & Chr(10) & "Last Modified: " & _ Format(.Fields("MostRecentlyModified"), "m/d/yy")) If .Fields("Participants") = "External" Then ReservationRange.Font.Bold = True End If .MoveNext Loop End With End If Application.StatusBar = False Set qdfRetrieveCurrent = Nothing Set rsRecordsToRetrieve = Nothing Set ReservationRange = Nothing End Sub Sub FromDBtoForm(rsRecordsToEdit As Recordset, WhichRoom As String) Dim StopTime As Date, StartTime As Date Dim RoomListIndex As Integer, StartTimeListIndex As Integer, i As Integer Dim StopTimeListIndex As Integer, DateListIndex As Integer Dim WhichDate As Date Dim ResourceCount As Integer ResourceCount = ActiveSheet.Cells(600, 1).End(xlUp).Row - 1 StartTime = rsRecordsToEdit.Fields("StartTime") StopTime = rsRecordsToEdit.Fields("StopTime") WhichDate = rsRecordsToEdit.Fields("ReservationDate") GetDropdownIndices RoomListIndex, WhichRoom, StartTime, StartTimeListIndex, _ StopTime, StopTimeListIndex, WhichDate, DateListIndex With ReservationForm For i = 1 To ResourceCount .ResourceListBox.AddItem (Sheets("UserNames").Cells(i, 4).Value) Next i .DateDropDown.Value = Sheets("UserNames").Cells(DateListIndex, 5) .ResourceListBox.Selected(RoomListIndex - 1) = True .ddStartTime.ListIndex = StartTimeListIndex - 1 .ddStopTime.ListIndex = StopTimeListIndex - 1 .SetupPeriods = rsRecordsToEdit.Fields("SetupPeriods") .CleanupPeriods = rsRecordsToEdit.Fields("CleanupPeriods") If rsRecordsToEdit.Fields("RoundTables") = "Round Tables" Then .tbChairsPerTable.Visible = True .tbChairsPerTable.Text = rsRecordsToEdit.Fields("ChairsPerTable") .lblChairsPerTable.Visible = True Else .tbChairsPerTable.Visible = False .lblChairsPerTable.Visible = False End If .PurposeBox.Value = rsRecordsToEdit.Fields("Purpose") .ReservedForBox.Value = rsRecordsToEdit.Fields("ReservedFor") If rsRecordsToEdit.Fields("Participants") = "Internal" Then .obInternal.Value = True ElseIf rsRecordsToEdit.Fields("Participants") = "External" Then .obExternal.Value = True End If 'Similar and repetitive code omitted here .cbDept.Value = rsRecordsToEdit.Fields("Department") .tbAccount.Value = rsRecordsToEdit.Fields("Account") End With Set dbReservatioons = Nothing Set rsRecordsToEdit = Nothing End Sub Sub GetMasterID(MasterResID As Long) Dim rsMasterTable As Recordset Set rsMasterTable = dbReservation.TableDefs("Masters") _ .OpenRecordset(dbOpenDynaset) With rsMasterTable .AddNew .Update .MoveLast MasterResID = .Fields("MasterID") .Close End With End Sub Sub RemoveReservation() Dim MeetingRange As Range, SetUpRange As Range, CleanUpRange As Range Dim ICI As Integer, ReservationCount As Long, i As Long Dim WhichDate As Date, WhichRoom As String, StartTime As Date, StopTime As Date Dim WhichColumn As Integer Dim Confirm As Integer Dim rsReservation As Recordset, rsReserver As Recordset, _ rsResource As Recordset Dim rsTableForSeek As Recordset Dim MasterResID As Long, ResourceID As Long Dim qdfEditDetails As QueryDef Dim rsRecordsToEdit As Recordset Dim RecordID As Long Dim Msg As String, Style As Integer, Title As String, Response As Integer Dim CanRemove As Boolean Dim CountSheets As Integer BookCheck = ActiveWorkbook Is ThisWorkbook If Not BookCheck Then MsgBox "Please use this command only with the Resources workbook active." End End If If Not SuppressWarning Then Confirm = MsgBox("Are you sure you want to delete this reservation?", _ vbOKCancel) If Confirm <> 1 Then Exit Sub End If End If DatabaseName = ThisWorkbook.Sheets("UserNames").Cells(1, 3) Set dbReservation = OpenDatabase(DatabaseName, False, False, "MS Access") Set rsReservation = dbReservation.TableDefs("Reservations") _ .OpenRecordset(dbOpenDynaset) Set rsReserver = dbReservation.TableDefs("Reservers") _ .OpenRecordset(dbOpenDynaset) Set rsResource = dbReservation.TableDefs("Resources") _ .OpenRecordset(dbOpenDynaset) ICI = ActiveCell.Interior.ColorIndex If ICI <> 6 And ICI <> 3 Then MsgBox "To remove a reservation, please begin by selecting a cell " _ & "that's part of an existing reservation -- that is, a red " _ & "cell or a yellow cell." Exit Sub End If WhichDate = ActiveSheet.Name WhichRoom = ActiveSheet.Cells(ActiveCell.Row, 1).Value ConvertResource WhichRoom, ResourceID, rsResource WhichColumn = ActiveCell.Column - 1 Do While Cells(ActiveCell.Row, WhichColumn) = _ Cells(ActiveCell.Row, ActiveCell.Column) WhichColumn = WhichColumn - 1 Loop StartTime = ActiveSheet.Cells(1, WhichColumn + 1).Value MasterResID = FindReservationMasterIDInDB _ (dbReservation, WhichDate, ResourceID, StartTime) Set qdfEditDetails = dbReservation.QueryDefs("DetailRecords") qdfEditDetails.Parameters("WhichID") = MasterResID Set rsRecordsToEdit = qdfEditDetails.OpenRecordset(dbOpenDynaset) With rsRecordsToEdit .MoveLast ReservationCount = .RecordCount .MoveFirst End With If ReservationCount > 1 Then Msg = "This reservation is one of a recurring group or a multi-room " & _ "group. " & Chr(10) & "Do you want to delete all the records " & _ "as a group?" & Chr(10) & "(If you click No, you will delete " & _ "only the reservation you selected.)" Style = vbYesNoCancel Title = "Delete multiple reservations" Response = MsgBox(Msg, Style, Title) If Response = vbCancel Then End ElseIf Response = vbNo Then rsRecordsToEdit.Close RecordID = FindReservationDetailIDInDB _ (dbReservation, WhichDate, ResourceID, StartTime) Set qdfEditDetails = dbReservation.QueryDefs("EditOneRecord") qdfEditDetails.Parameters("WhichID") = RecordID Set rsRecordsToEdit = qdfEditDetails.OpenRecordset(dbOpenDynaset) End If End If Set MeetingRange = Selection GetFullReservationRange SetUpRange, MeetingRange, CleanUpRange rsRecordsToEdit.MoveFirst CanRemove = CheckEditPermits(MeetingRange) If Not CanRemove Then MsgBox "Only the person who made the reservation can delete it." End End If Sheets(MeetingRange.Parent.Name).Activate MeetingRange.Select SuppressWarning = True RemoveReservationFromWorksheet SetUpRange, MeetingRange, CleanUpRange SuppressWarning = False With rsRecordsToEdit Do While Not .EOF .Edit .Fields("Cancelled") = True .Update .MoveNext Loop End With GetSingleDayFromDB Set rsReservation = Nothing Set rsRooms = Nothing Set qdfRecordDetails = Nothing Set rsRecordsToDelete = Nothing End Sub Sub ConvertResource(ResourceName As String, ResourceID As Long, _ rsResource As Recordset) Dim Criterion As String Criterion = "ResourceName = '" & ResourceName & "'" With rsResource .FindFirst Criterion ResourceID = .Fields("ResourceID") End With End Sub Function FindReservationMasterIDInDB(dbReservation As Database, _ WhichDate As Date, WhichRoom As Long, StartTime As Date) As Long Dim qdfDetail As QueryDef Dim rsDetail As Recordset Set qdfDetail = dbReservation.QueryDefs("FindSingleReservation") qdfDetail.Parameters("WhichRoom") = WhichRoom qdfDetail.Parameters("WhichDate") = WhichDate qdfDetail.Parameters("WhichTime") = Format(StartTime, "Medium Time") Set rsDetail = qdfDetail.OpenRecordset(dbOpenDynaset) FindReservationMasterIDInDB = rsDetail.Fields("MasterID") Set qdfDetail = Nothing Set rsDetail = Nothing End Function
| 