So far, your application will probably not compile because some features used in the code have not been written yet. You’re almost finished with the application anyway. You are now ready to tie everything together by adding the VBA code to the Project Tracker and Contacts forms. Most of this code will be event procedures that fire, for example, when certain buttons are clicked. Some of the code will be local procedures in the form that deal with user-interface-specific features that would not make sense to put in a standard or class module.
An example of the Project Tracker form, called frmProjects, is shown in Figure 13-26 with some sample data populated. You will revisit this form in more detail at the end of the chapter, where you will explore its cool features. For now, just keep this form in mind to help you understand the purpose of the code that you are about to write (and have already written).
Figure 13-26
Try It Out-Writing Code for the frmProjects Form
As previously mentioned, you are now ready to write the VBA code that will finish up the application. You will start with the frmProjects form and will finish with the frmContacts form.
Open the frmProjects form and select the Form_Load event for the form to bring up the Visual Basic editor. Add the following code to the form:
Private Sub Form_Load() On Error GoTo HandleError Set objProjects = New clsProjects Set rsProjects = New ADODB.Recordset 'load non-closed projects as default (open, on hold, etc.) blnAllRecords = False 'make sure unclosed is enabled by default so only unclosed records load first togShowUnclosed.Value = True togShowAll.Value = False 'lock project id field so no edits allowed (primary key assigned by database) txtProjectId.Locked = True 'load the records in the recordset and display the first one on the form Call LoadRecords Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, "Form_Load" Exit Sub End Sub
Add the following code to the General Declarations section of the form:
Option Compare Database Option Explicit Dim blnAddMode As Boolean Dim blnAllRecords As Boolean Dim rsProjects As ADODB.Recordset Dim objProjects As clsProjects Dim rsComments As ADODB.Recordset Dim rsContacts As ADODB.Recordset Dim rsAttachments As ADODB.Recordset Const PROJECTS_FORM As String = "frmProjects" Dim intCurrProjectRecord As Integer
Add Click event procedures to the form for making updates to the data:
Private Sub cmdAddNew_Click() On Error GoTo HandleError 'clear the current controls to enable adding a new 'Project record Call AddEmptyProjectRecord Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdAddNew_Click" Exit Sub End Sub Private Sub cmdSave_Click() On Error GoTo HandleError Dim intCurProject As Integer 'save the id of the current record if in update mode If Not blnAddMode Then intCurProject = objProjects.ProjectId Else intCurProject = 0 End If 'populate object with current info on form objProjects.PopulatePropertiesFromForm 'save all changes to current record objProjects.Save blnAddMode, rsProjects 'save changes in list boxes in tabs 1-3 Call SaveComments Call SaveContacts Call SaveAttachments 'move back to the project that was current before the requery If intCurProject > 0 Then 'move back to the project that was just updated rsProjects.Find "[intProjectId] = " & intCurProject Else 'if just added new record, move to the beginning of 'the recordset Call MoveToFirstRecord(intCurrProjectRecord, rsProjects, objProjects, _ blnAddMode) End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, "cmdSave_Click" Exit Sub End Sub Private Sub cmdDelete_Click() On Error GoTo HandleError 'delete the current record from the local disconnected recordset objProjects.Delete objProjects.ProjectId, blnAddMode, rsProjects 'move to the first record in the recordset after the delete Call MoveToFirstRecord(intCurrProjectRecord, rsProjects, objProjects, _ blnAddMode) 'populate the controls on the form with the current record Call PopulateProjectsControls Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdDelete_Click" Exit Sub End Sub
Add the following Click event procedures to the form for navigating through the data:
Private Sub cmdMoveFirst_Click() On Error GoTo HandleError 'move to the first record in the local disconnected recordset Call MoveToFirstRecord(intCurrProjectRecord, rsProjects, objProjects, _ blnAddMode) 'populate the controls on the form with the current record Call PopulateProjectsControls Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdMoveFirst_Click" Exit Sub End Sub Private Sub cmdMoveLast_Click() On Error GoTo HandleError 'move to the last record in the local disconnected recordset Call MoveToLastRecord(intCurrProjectRecord, rsProjects, objProjects, _ blnAddMode) 'populate the controls on the form with the current record Call PopulateProjectsControls Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdMoveLast_Click" Exit Sub End Sub Private Sub cmdMoveNext_Click() On Error GoTo HandleError 'move to the next record in the local disconnected recordset Call MoveToNextRecord(intCurrProjectRecord, rsProjects, objProjects, _ blnAddMode) 'populate the controls on the form with the current record Call PopulateProjectsControls Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdMoveNext_Click" Exit Sub End Sub Private Sub cmdMovePrevious_Click() On Error GoTo HandleError 'move to the previous record in the local disconnected recordset Call MoveToPreviousRecord(intCurrProjectRecord, rsProjects, objProjects, _ blnAddMode) 'populate the controls on the form with the current record Call PopulateProjectsControls Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdMovePrevious_Click" Exit Sub End Sub
Add the following Click event procedures to the form for managing the contacts associated with a given project:
Private Sub cmdDeleteContact_Click() On Error GoTo HandleError 'delete the selected contact from the list (not the database, 'just the screen) If lstContacts.ListIndex >= 0 Then lstContacts.RemoveItem (lstContacts.ListIndex) End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdDeleteContact_Click" Exit Sub End Sub Private Sub cmdManageContacts_Click() On Error GoTo HandleError 'store the current projectid so a contact can be added intContactProjectAdd = objProjects.ProjectId 'open contacts form so user can add contact to existing project DoCmd.OpenForm "frmContacts" Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdManageContacts_Click" Exit Sub End Sub Private Sub cmdEmailContact_Click() On Error GoTo HandleError 'create a new email to the selected contact using the email column DoCmd.SendObject acSendNoObject, , , lstContacts.Column(5), , , , , True, False Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdEmailContact_Click" Exit Sub End Sub Private Sub cmdViewContact_Click() On Error GoTo HandleError 'if there is a selected record in the list If lstContacts.ListIndex <> -1 Then 'store the current projectid so a contact can be added intContactProjectAdd = objProjects.ProjectId 'store the current contact so it can be retrieved 'from the contacts form intContactProjectLookup = lstContacts.Column(6) DoCmd.OpenForm "frmContacts" intContactProjectLookup = 0 End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdViewContact_Click" Exit Sub End Sub
Add the following Click event procedures to the form for managing the comments associated with a given project:
Private Sub cmdAddComment_Click() On Error GoTo HandleError 'add comment/task to list box lstComments.AddItem (txtAddComment) 'clear AddComment box since you just added it txtAddComment = "" Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdAddComment_Click" Exit Sub End Sub Private Sub cmdDeleteComment_Click() On Error GoTo HandleError 'remove the selected item from the list If lstComments.ListIndex >= 0 Then lstComments.RemoveItem (lstComments.ListIndex) End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdDeleteComment_Click" Exit Sub End Sub
Add the following Click event procedures to the form for managing the file attachments associated with a given project:
Private Sub cmdAddAttachment_Click() On Error GoTo HandleError 'add file attachment to list box lstFileAttachments.AddItem (txtFileDesc & ";" & txtFileName) 'clear text boxes since info was added to list txtFileDesc = "" txtFileName = "" Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdAddAttachment_Click" Exit Sub End Sub Private Sub cmdFileBrowse_Click() On Error GoTo HandleError 'show the open dialog and load 'selected file name in text box txtFileName = GetFileNameBrowse Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdFileBrowse_Click" Exit Sub End Sub Private Sub cmdOpenFile_Click() On Error GoTo HandleError Dim RetVal As Variant Dim strFile As String 'if the user selected a value If lstFileAttachments.ListIndex >= 0 Then 'retrieve the file name from the list box strFile = lstFileAttachments.Column(1) 'open the selected file Call OpenFileAttachment(strFile) End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdOpenFile_Click" Exit Sub End Sub Private Sub cmdRemoveAttachment_Click() On Error GoTo HandleError 'remove the selected item from the list (if an item has been selected) If lstFileAttachments.ListIndex >= 0 Then lstFileAttachments.RemoveItem (lstFileAttachments.ListIndex) End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdRemoveAttachment_Click" Exit Sub End Sub
Add the following AddEmptyProject procedure:
Sub AddEmptyProjectRecord() On Error GoTo HandleError 'set add mode to true blnAddMode = True 'clear the current values in the Projects object objProjects.ClearObject 'clear the current controls on the form so the 'user can fill in values for the new record Call ClearProjectsControls Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "AddEmptyProjectRecord" Exit Sub End Sub
Add the following PopulateProjectsControls procedure:
Sub PopulateProjectsControls() On Error GoTo HandleError 'Populate the controls on the Projects form with the values of the 'current record in the Projects object. If Not rsProjects.BOF And Not rsProjects.EOF Then Me.txtProjectId = objProjects.ProjectId Me.txtProjectTitle = objProjects.ProjectTitle Me.txtProjectDesc = objProjects.ProjectDescription Me.cboPriority = objProjects.Priority Me.txtReferenceNum = objProjects.ReferenceNum Me.txtMoneyBudget = objProjects.MoneyBudget Me.txtMoneyToDate = objProjects.MoneyToDate Me.txtHoursBudget = objProjects.HoursBudget Me.txtHoursToDate = objProjects.HoursToDate If objProjects.DateDue = "1/1/1900" Then Me.txtDateDue = "" Else Me.txtDateDue = objProjects.DateDue End If Me.cboStatus = objProjects.Status 'populate the recordset for tab 1 Set rsComments = New ADODB.Recordset Set rsComments = objProjects.RetrieveComments(objProjects.ProjectId) PopulateListFromRecordset Me.lstComments, rsComments, 1 rsComments.Close 'populate the recordset for tab 2 Set rsContacts = New ADODB.Recordset Set rsContacts = objProjects.RetrieveContacts(objProjects.ProjectId) PopulateListFromRecordset Me.lstContacts, rsContacts, 7 rsContacts.Close 'populate the recordset for tab 3 Set rsAttachments = New ADODB.Recordset Set rsAttachments = _ objProjects.RetrieveAttachments(objProjects.ProjectId) PopulateListFromRecordset Me.lstFileAttachments, rsAttachments, 2 rsAttachments.Close 'display the record count on the form lblRecordNum.Caption = "Record " & intCurrProjectRecord & " Of " & _ rsProjects.RecordCount ElseIf rsProjects.BOF Then 'past beginning of recordset so move to first record Call MoveToFirstRecord(intCurrProjectRecord, rsProjects, _ objProjects, blnAddMode) ElseIf rsProjects.EOF Then 'past end of recordset so move back to last record Call MoveToLastRecord(intCurrProjectRecord, rsProjects, _ objProjects, blnAddMode) End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "PopulateProjectsControls" Exit Sub End Sub
Add the following ClearProjectControls procedure:
Sub ClearProjectsControls() On Error GoTo HandleError 'clear the values in the controls on the form Me.txtProjectId = "" Me.txtProjectTitle = "" Me.txtProjectDesc = "" Me.cboPriority = 0 Me.txtReferenceNum = "" Me.txtMoneyBudget = "" Me.txtMoneyToDate = "" Me.txtHoursBudget = "" Me.txtHoursToDate = "" Me.txtDateDue = "" Me.cboStatus = 0 'clear the values in the text box controls on the tab control pages Me.txtAddComment = "" Me.txtFileName = "" Me.txtFileDesc = "" Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "ClearProjectsControls" Exit Sub End Sub
Add the following PopulateComboBoxes procedure:
Sub PopulateComboBoxes() On Error GoTo HandleError 'populate the priority combo box cboPriority.RowSource = "" cboPriority.LimitToList = True cboPriority.ColumnCount = 1 cboPriority.RowSourceType = "Value List" cboPriority.AddItem ("Normal") cboPriority.AddItem ("High") cboPriority.AddItem ("Low") 'populate the status combo box cboStatus.RowSource = "" cboStatus.LimitToList = True cboStatus.ColumnCount = 1 cboStatus.RowSourceType = "Value List" cboStatus.AddItem ("Open") cboStatus.AddItem ("Closed") cboStatus.AddItem ("On Hold") Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "PopulateComboBoxes" Exit Sub End Sub
Add the following PopulateListFromRecordset procedure:
Sub PopulateListFromRecordset(lstList As ListBox, rsRecordset As _ ADODB.Recordset, intNumCols As Integer) On Error GoTo HandleError Dim intCounter As Integer Dim strItem As String With lstList .RowSource = "" .ColumnCount = intNumCols .RowSourceType = "Value List" End With 'add all of the values in the recordset to the list box Do Until rsRecordset.EOF 'for each item in the current record, build string For intCounter = 0 To intNumCols - 1 strItem = strItem & rsRecordset(intCounter).Value & ";" Next intCounter lstList.AddItem (strItem) strItem = "" rsRecordset.MoveNext Loop Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "PopulateListFromRecordset" Exit Sub End Sub
Add the Form_Unload procedure for frmProjects:
Private Sub Form_Unload(Cancel As Integer) On Error GoTo HandleError 'close the recordset and free the memory rsProjects.Close Set rsProjects = Nothing Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, "Form_Unload" Exit Sub End Sub
Add the LoadRecords procedure:
Sub LoadRecords() On Error GoTo HandleError intCurrProjectRecord = 0 blnAddMode = False 'populate the main recordset Set rsProjects = objProjects.RetrieveProjects(blnAllRecords) 'if the recordset is empty If rsProjects.BOF And rsProjects.EOF Then Exit Sub Else 'populate the status and priority combo boxes Call PopulateComboBoxes 'populate the object with values in the recordset objProjects.PopulatePropertiesFromRecordset rsProjects Call MoveToFirstRecord(intCurrProjectRecord, rsProjects, objProjects, _ blnAddMode) 'populate the controls on the form with the current record Call PopulateProjectsControls End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, "LoadRecords" Exit Sub End Sub
Add the following procedures for dealing with the toggle button allowing the user to switch from unclosed projects to all projects:
Private Sub togShowAll_Click() On Error GoTo HandleError If togShowAll.Value = True Then blnAllRecords = True 'make sure Show Unclosed is not checked any more togShowUnclosed.Value = False 'now, populate the form with all projects records LoadRecords End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "togShowAll_Click" Exit Sub End Sub Private Sub togShowUnclosed_Click() On Error GoTo HandleError If togShowUnclosed.Value = True Then blnAllRecords = False 'make sure Show All is not checked any more togShowAll.Value = False 'now, populate the form with all unclosed projects records LoadRecords End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "togShowUnclosed_Click" Exit Sub End Sub
Add the following procedures that deal with saving the records displayed on the tabs of the form to the database:
Sub SaveComments() On Error GoTo HandleError Dim strSQLStatement As String Dim intId As Integer Dim strComment As String Dim intCounter 'remove all current comments in database for this project strSQLStatement = BuildSQLDeleteProjectsComments(objProjects.ProjectId) ProcessUpdate (strSQLStatement) 'add back all comments based on current list (easier than tracking 'changes, inserts, and deletes) For intCounter = 0 To lstComments.ListCount - 1 intId = objProjects.ProjectId strComment = lstComments.Column(0, intCounter) strSQLStatement = BuildSQLInsertProjectsComments(intId, strComment) ProcessUpdate (strSQLStatement) Next intCounter Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, "SaveComments" Exit Sub End Sub Sub SaveContacts() On Error GoTo HandleError Dim strSQLStatement As String Dim intContId As Integer Dim intProjId As Integer Dim intCounter As Integer 'remove all current contacts in database for this project strSQLStatement = BuildSQLDeleteProjectsContacts(objProjects.ProjectId) ProcessUpdate (strSQLStatement) 'add back all contacts based on current list (easier than tracking 'changes, inserts, and deletes) For intCounter = 0 To lstContacts.ListCount - 1 intContId = lstContacts.Column(6, intCounter) intProjId = objProjects.ProjectId strSQLStatement = BuildSQLInsertProjectsContacts(intContId, intProjId) ProcessUpdate (strSQLStatement) Next intCounter Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, "SaveContacts" Exit Sub End Sub Sub SaveAttachments() On Error GoTo HandleError Dim strSQLStatement As String Dim intId As Integer Dim strDesc As String Dim strFile As String Dim intCounter As Integer 'remove all current file attachments in database for this project strSQLStatement = BuildSQLDeleteProjectsAttachments(objProjects.ProjectId) ProcessUpdate (strSQLStatement) 'add back all file attachments based on current list (easier than tracking 'changes, inserts, and deletes) For intCounter = 0 To lstFileAttachments.ListCount - 1 intId = objProjects.ProjectId strDesc = lstFileAttachments.Column(0, intCounter) strFile = lstFileAttachments.Column(1, intCounter) strSQLStatement = BuildSQLInsertProjectsAttachments(intId, strDesc, _ strFile) ProcessUpdate (strSQLStatement) Next intCounter Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "SaveComments" Exit Sub End Sub
Add the following RefreshContacts procedure to frmProjects. This procedure gets called whenever the user clicks to add the contact to the current project.
Sub RefreshContacts() On Error GoTo HandleError 'populate the recordset for tab 2
Set rsContacts = New ADODB.Recordset Set rsContacts = objProjects.RetrieveContacts(objProjects.ProjectId) PopulateListFromRecordset Me.lstContacts, rsContacts, 7 rsContacts.Close Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "RefreshContacts" Exit Sub End Sub
How It Works
First, you added the code to the frmProjects form to tie it to the rest of the code created earlier in this chapter. As you have learned throughout this book, you typically tie the user interface to the rest of the code through various event procedures on the form. In the Form_Load event for the frmProjects form, you added a few startup settings, such as locking the ProjectId field to prevent editing and to load a project record onto the form.
Private Sub Form_Load() On Error GoTo HandleError Set objProjects = New clsProjects Set rsProjects = New ADODB.Recordset 'load non-closed projects as default (open, on hold, etc.) blnAllRecords = False 'make sure unclosed is enabled by default so only unclosed records load first togShowUnclosed.Value = True togShowAll.Value = False 'lock project id field so no edits allowed (primary key assigned by database) txtProjectId.Locked = True 'load the records in the recordset and display the first one on the form Call LoadRecords Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, "Form_Load" Exit Sub End Sub
Next, you added various declarations to the General Declarations section of the form, in order to declare various recordsets that will store the projects and related records. You then added Click events for the cmdAddNew, cmdSave, and cmdDelete controls that fire when the user selects the respective button on the form. For example, the cmdAddNew_Click event procedure calls a procedure that adds an empty project record to allow the user to begin adding a new project record.
Private Sub cmdAddNew_Click() On Error GoTo HandleError 'clear the current controls to enable adding a new 'Project record Call AddEmptyProjectRecord Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdAddNew_Click" Exit Sub End Sub
The cmdSave_Click event saves a new or modified record to the database. When you click the cmdSave button, the ID of the current record is saved if the mode is Update Mode.
Private Sub cmdSave_Click() On Error GoTo HandleError Dim intCurProject As Integer 'save the id of the current record if in update mode If Not blnAddMode Then intCurProject = objProjects.ProjectId Else intCurProject = 0 End If
The objProjects object (created based upon the clsProject that you created earlier) is then populated with the values on the form:
'populate object with current info on form objProjects.PopulatePropertiesFromForm
The changes to the current record are then saved to the database:
'save all changes to current record objProjects.Save blnAddMode, rsProjects 'save changes in list boxes in tabs 1-3 Call SaveComments Call SaveContacts Call SaveAttachments
If an existing record was updated, the updated record is reset to the current record. If Add Mode was activated, the first record now becomes the current record:
'move back to the project that was current before the requery If intCurProject > 0 Then 'move back to the project that was just updated rsProjects.Find "[intProjectId] = " & intCurProject Else 'if just added new record, move to the beginning of 'the recordset Call MoveToFirstRecord(intCurrProjectRecord, rsProjects, objProjects, _ blnAddMode) End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdSave_Click" Exit Sub End Sub
Various Click event procedures were added to each of the command buttons to be used for record navigation. For example, the cmdMoveFirst_Click procedure calls a procedure to move to the first record and then populates the controls on the form with the data of the newly current record:
Private Sub cmdMoveFirst_Click() On Error GoTo HandleError 'move to the first record in the local disconnected recordset Call MoveToFirstRecord(intCurrProjectRecord, rsProjects, objProjects, _ blnAddMode) 'populate the controls on the form with the current record Call PopulateProjectsControls Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdMoveFirst_Click" Exit Sub End Sub
Next, several procedures were added to the form for managing contacts. For example, the cmdDeleteContacts_Click procedure deletes the selected contact from the list box on the form:
Private Sub cmdDeleteContact_Click() On Error GoTo HandleError 'delete the selected contact from the list (not the database, just the screen) If lstContacts.ListIndex >= 0 Then lstContacts.RemoveItem (lstContacts.ListIndex) End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdDeleteContact_Click" Exit Sub End Sub
The cmdManageContacts_Click event opens the frmContacts form so the user can add a contact to the existing project:
Private Sub cmdManageContacts_Click() On Error GoTo HandleError 'store the current projectid so a contact can be added intContactProjectAdd = objProjects.ProjectId 'open contacts form so user can add contact to existing project DoCmd.OpenForm "frmContacts" Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdManageContacts_Click" Exit Sub End Sub
The cmdEmailContact_Click event procedure executes the SendObject method of the DoCmd object to generate an empty e-mail to the selected contact:
Private Sub cmdEmailContact_Click() On Error GoTo HandleError 'create a new email to the selected contact using the email column DoCmd.SendObject acSendNoObject, , , lstContacts.Column(5), , , , , True, False Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdEmailContact_Click" Exit Sub End Sub
The cmdViewContact_Click event opened the frmContacts form and displayed the contact record that was selected:
Private Sub cmdViewContact_Click() On Error GoTo HandleError 'if there is a selected record in the list If lstContacts.ListIndex <> -1 Then 'store the current projectid so a contact can be added intContactProjectAdd = objProjects.ProjectId 'store the current contact so it can be retrieved 'from the contacts form intContactProjectLookup = lstContacts.Column(6) DoCmd.OpenForm "frmContacts" intContactProjectLookup = 0 End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdViewContact_Click" Exit Sub End Sub
Next, Click event procedures were created for adding and deleting comments from the lstComments list box. Event procedures were then added for managing file attachments associated with a given project. For example, the cmdAddAttachment_Click event added the value in the txtFileDesc and txtFileName fields to the lstFileAttachments list box:
Private Sub cmdAddAttachment_Click() On Error GoTo HandleError 'add file attachment to list box lstFileAttachments.AddItem (txtFileDesc & ";" & txtFileName) 'clear text boxes since info was added to list txtFileDesc = "" txtFileName = "" Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdAddAttachment_Click" Exit Sub End Sub
The cmdFileBrowse_Click event called the GetFileNameBrowse function, which then called the external function to open the File Browse dialog box:
Private Sub cmdFileBrowse_Click() On Error GoTo HandleError 'show the open dialog and load 'selected file name in text box txtFileName = GetFileNameBrowse Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdFileBrowse_Click" Exit Sub End Sub
The cmdOpenFile_Click event allows a user to preview a selected attachment in the native application. If the user selects an attachment from the list, the OpenFileAttachment procedure is executed to call the external function for opening another program associated with the attachment.
Private Sub cmdOpenFile_Click() On Error GoTo HandleError Dim RetVal As Variant
Dim strFile As String 'if the user selected a value If lstFileAttachments.ListIndex >= 0 Then 'retrieve the file name from the list box strFile = lstFileAttachments.Column(1) 'open the selected file Call OpenFileAttachment(strFile) End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "cmdOpenFile_Click" Exit Sub End Sub
An AddEmptyProjectRecord procedure was added to clear the values in the object:
Sub AddEmptyProjectRecord() On Error GoTo HandleError 'set add mode to true blnAddMode = True 'clear the current values in the Projects object objProjects.ClearObject 'clear the current controls on the form so the 'user can fill in values for the new record Call ClearProjectsControls Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "AddEmptyProjectRecord" Exit Sub End Sub
The PopulateProjectsControls procedure populated the controls on the frmProjects form with the values of the current record in the objProjects object:
Sub PopulateProjectsControls() On Error GoTo HandleError 'Populate the controls on the Projects form with the values of the
'current record in the Projects object. If Not rsProjects.BOF And Not rsProjects.EOF Then Me.txtProjectId = objProjects.ProjectId Me.txtProjectTitle = objProjects.ProjectTitle Me.txtProjectDesc = objProjects.ProjectDescription Me.cboPriority = objProjects.Priority Me.txtReferenceNum = objProjects.ReferenceNum Me.txtMoneyBudget = objProjects.MoneyBudget Me.txtMoneyToDate = objProjects.MoneyToDate Me.txtHoursBudget = objProjects.HoursBudget Me.txtHoursToDate = objProjects.HoursToDate If objProjects.DateDue = "1/1/1900" Then Me.txtDateDue = "" Else Me.txtDateDue = objProjects.DateDue End If Me.cboStatus = objProjects.Status
After the object was populated, the tab controls were populated with the values retrieved from the database:
'populate the recordset for tab 1 Set rsComments = New ADODB.Recordset Set rsComments = objProjects.RetrieveComments(objProjects.ProjectId) PopulateListFromRecordset Me.lstComments, rsComments, 1 rsComments.Close 'populate the recordset for tab 2 Set rsContacts = New ADODB.Recordset Set rsContacts = objProjects.RetrieveContacts(objProjects.ProjectId) PopulateListFromRecordset Me.lstContacts, rsContacts, 7 rsContacts.Close 'populate the recordset for tab 3 Set rsAttachments = New ADODB.Recordset Set rsAttachments = _ objProjects.RetrieveAttachments(objProjects.ProjectId) PopulateListFromRecordset Me.lstFileAttachments, rsAttachments, 2 rsAttachments.Close
The record count was also displayed, so the user could see how many records were available for viewing and updating:
'display the record count on the form lblRecordNum.Caption = "Record " & intCurrProjectRecord & " Of " & _ rsProjects.RecordCount
If no current record was available because the recordset was at the beginning or end, you moved to another record accordingly:
ElseIf rsProjects.BOF Then 'past beginning of recordset so move to first record
Call MoveToFirstRecord(intCurrProjectRecord, rsProjects, _ objProjects, blnAddMode) ElseIf rsProjects.EOF Then 'past end of recordset so move back to last record Call MoveToLastRecord(intCurrProjectRecord, rsProjects, _ objProjects, blnAddMode) End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "PopulateProjectsControls" Exit Sub End Sub
The ClearProjectControls procedure was added to the frmProjects form. This procedure empties the various controls on the form.
Sub ClearProjectsControls() On Error GoTo HandleError 'clear the values in the controls on the form Me.txtProjectId = "" Me.txtProjectTitle = "" Me.txtProjectDesc = "" Me.cboPriority = 0 Me.txtReferenceNum = "" Me.txtMoneyBudget = "" Me.txtMoneyToDate = "" Me.txtHoursBudget = "" Me.txtHoursToDate = "" Me.txtDateDue = "" Me.cboStatus = 0 'clear the values in the text box controls on the tab control pages Me.txtAddComment = "" Me.txtFileName = "" Me.txtFileDesc = "" Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "ClearProjectsControls" Exit Sub End Sub
A procedure called PopulateComboBoxes was added to populate the values in the cboPriority and cboStatus combo boxes on the form:
Sub PopulateComboBoxes() On Error GoTo HandleError 'populate the priority combo box cboPriority.RowSource = "" cboPriority.LimitToList = True cboPriority.ColumnCount = 1 cboPriority.RowSourceType = "Value List" cboPriority.AddItem ("Normal") cboPriority.AddItem ("High") cboPriority.AddItem ("Low") 'populate the status combo box cboStatus.RowSource = "" cboStatus.LimitToList = True cboStatus.ColumnCount = 1 cboStatus.RowSourceType = "Value List" cboStatus.AddItem ("Open") cboStatus.AddItem ("Closed") cboStatus.AddItem ("On Hold") Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "PopulateComboBoxes" Exit Sub End Sub
The PopulateListFromRecordset procedure populated a list box control with the values in a record-set. This procedure was used to populate the list boxes on the tab controls with the values from the database (for example, the comments, contacts, and attachments).
Sub PopulateListFromRecordset(lstList As ListBox, rsRecordset As _ ADODB.Recordset, intNumCols As Integer) On Error GoTo HandleError Dim intCounter As Integer Dim strItem As String With lstList .RowSource = "" .ColumnCount = intNumCols .RowSourceType = "Value List" End With 'add all of the values in the recordset to the list box Do Until rsRecordset.EOF 'for each item in the current record, build string
For intCounter = 0 To intNumCols - 1 strItem = strItem & rsRecordset(intCounter).Value & ";" Next intCounter lstList.AddItem (strItem) strItem = "" rsRecordset.MoveNext Loop Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "PopulateListFromRecordset" Exit Sub End Sub
The Form_Unload procedure for frmProjects closed the recordset and freed the memory associated with the recordset:
Private Sub Form_Unload(Cancel As Integer) On Error GoTo HandleError 'close the recordset and free the memory rsProjects.Close Set rsProjects = Nothing Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, "Form_Unload" Exit Sub End Sub
Next, you added the LoadRecords procedure, which is responsible for retrieving the project records from the database and displaying a record on the form:
Sub LoadRecords() On Error GoTo HandleError intCurrProjectRecord = 0 blnAddMode = False 'populate the main recordset Set rsProjects = objProjects.RetrieveProjects(blnAllRecords) 'if the recordset is empty If rsProjects.BOF And rsProjects.EOF Then
Exit Sub Else 'populate the status and priority combo boxes Call PopulateComboBoxes 'populate the object with values in the recordset objProjects.PopulatePropertiesFromRecordset rsProjects Call MoveToFirstRecord(intCurrProjectRecord, rsProjects, objProjects, _ blnAddMode) 'populate the controls on the form with the current record Call PopulateProjectsControls End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "LoadRecords" Exit Sub End Sub
Two procedures were added to handle the toggle feature that enables the user to switch from displaying unclosed projects to all projects. For example, the togShowAll_Click event set the blnAllRecords flag to True because the user had indicated he wished to see all records. The records were then loaded based on the selected option.
Private Sub togShowAll_Click() On Error GoTo HandleError If togShowAll.Value = True Then blnAllRecords = True 'make sure Show Unclosed is not checked any more togShowUnclosed.Value = False 'now, populate the form with all projects records LoadRecords End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _
"togShowAll_Click" Exit Sub End Sub
Various procedures were then added to deal with saving to the database the comments, contacts, and attachments records displayed on the tabs of the form. For example, the SaveComments procedure is responsible for removing all current comments in the database for the current project and then saving all comments in the list to the database. The delete and insert operations are performed because using these procedures is easier than keeping track of which comment records were changed, which ones were inserted, and which ones were deleted. Such a delete and reinsert operation is not appropriate in all circumstances. In the current situation, however, it works very well.
Sub SaveComments() On Error GoTo HandleError Dim strSQLStatement As String Dim intId As Integer Dim strComment As String Dim intCounter 'remove all current comments in database for this project strSQLStatement = BuildSQLDeleteProjectsComments(objProjects.ProjectId) ProcessUpdate (strSQLStatement) 'add back all comments based on current list (easier than tracking 'changes, inserts, and deletes) For intCounter = 0 To lstComments.ListCount - 1 intId = objProjects.ProjectId strComment = lstComments.Column(0, intCounter) strSQLStatement = BuildSQLInsertProjectsComments(intId, strComment) ProcessUpdate (strSQLStatement) Next intCounter Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "SaveComments" Exit Sub End Sub
To finish off the code for frmProjects, we added a RefreshContacts procedure that is called whenever the user clicks the button to add the contact to the current project. This feature ensures that the contacts tab is populated with the revised contact information.
Sub RefreshContacts() On Error GoTo HandleError 'populate the recordset for tab 2 Set rsContacts = New ADODB.Recordset Set rsContacts = objProjects.RetrieveContacts(objProjects.ProjectId) PopulateListFromRecordset Me.lstContacts, rsContacts, 7 rsContacts.Close Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, PROJECTS_FORM, _ "RefreshContacts" Exit Sub End Sub
The Contacts form, called frmContacts, is shown in Figure 13-27, so you can refresh your memory as to what it looks like. You are now going to add the code to implement the functionality of this form.
Figure 13-27
Try It Out-Writing Code for the frmContacts Form
You’re in the home stretch now. This is the last part of the application. You will now write the code behind the frmContacts form to finish the application.
Open the frmContacts form and select the Form_Load event for the form to bring up the Visual Basic Editor. Add the following code to the form:
Private Sub Form_Load() On Error GoTo HandleError Set objContacts = New clsContacts Set rsContacts = New ADODB.Recordset 'not in add mode blnAddMo de = False intCurrContactRecord = 0 Set rsContacts = objContacts.RetrieveContacts 'if the recordset is empty If rsContacts.BOF And rsContacts.EOF Then Exit Sub Else 'populate the object with values in the recordset objContacts.PopulatePropertiesFromRecordset rsContacts Call MoveToFirstRecord(intCurrContactRecord, rsContacts, _ objContacts, blnAddMode) 'populate the controls on the form with the current record Call PopulateContactsControls End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, CONTACTS_FORM, "Form_Load" Exit Sub End Sub
Add the following to the General Declarations section of the frmContacts form:
Option Compare Database Option Explicit Dim blnAddMode As Boolean Dim rsContacts As ADODB.Recordset Dim objContacts As clsContacts Const CONTACTS_FORM As String = "frmContacts" Dim intCurrContactRecord As Integer
Add the following event procedure to the frmContacts form:
Private Sub cmdAddToProject_Click() On Error GoTo HandleError Dim strSQLStatement As String 'build the SQL statement to insert a new contact for the current 'project on frmProjects strSQLStatement = BuildSQLInsertProjectsContacts(objContacts.ContactId, _ intContactProjectAdd) 'insert the record into the database ProcessUpdate (strSQLStatement) Call Forms("frmProjects").RefreshContacts 'close the Contacts form to return the user to the Project streen DoCmd.Close acForm, "frmContacts" Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, CONTACTS_FORM, _ "cmdAddToProject_Click" Exit Sub End Sub
Add the following event procedures to the frmContacts form to enable modification of records:
Private Sub cmdAddNew_Click() On Error GoTo HandleError 'clear the current controls to enable adding a new 'contact record Call AddEmptyContactRecord Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, CONTACTS_FORM, _ "cmdAddNew_Click" Exit Sub End Sub Private Sub cmdSave_Click() On Error GoTo HandleError Dim intCurContact As Integer 'save the id of the current record if in update mode If Not blnAddMode Then intCurContact = objContacts.ContactId Else intCurContact = 0 End If 'populate object with current info on form objContacts.PopulatePropertiesFromForm 'save all changes to current record objContacts.Save blnAddMode, rsContacts 'move back to the contact that was current before the requery If intCurContact > 0 Then 'move back to the contact that was just updated rsContacts.Find "[intContactId] = " & intCurContact Else 'if just added new record, move to the beginning of 'the recordset Call MoveToFirstRecord(intCurrContactRecord, rsContacts, _ objContacts, blnAddMode) End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, CONTACTS_FORM, "cmdSave_Click" Exit Sub End Sub Private Sub cmdDelete_Click() On Error GoTo HandleError 'delete the current record from the local disconnected recordset objContacts.Delete objContacts.ContactId, blnAddMode, rsContacts 'move to the first record in the recordset after the delete Call MoveToFirstRecord(intCurrContactRecord, rsContacts, objContacts, _ blnAddMode) 'populate the controls on the form with the current record Call PopulateContactsControls Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, CONTACTS_FORM, _ "cmdDelete_Click" Exit Sub End Sub
Add the following event procedures to the frmContacts form that navigates through the records:
Private Sub cmdMoveFirst_Click() On Error GoTo HandleError 'move to the first record in the local disconnected recordset Call MoveToFirstRecord(intCurrContactRecord, rsContacts, _ objContacts, blnAddMode) 'populate the controls on the form with the current record Call PopulateContactsControls Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, CONTACTS_FORM, _ "cmdMoveFirst_Click" Exit Sub End Sub Private Sub cmdMoveLast_Click() On Error GoTo HandleError 'move to the last record in the local disconnected recordset Call MoveToLastRecord(intCurrContactRecord, rsContacts, _ objContacts, blnAddMode) 'populate the controls on the form with the current record Call PopulateContactsControls Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, CONTACTS_FORM, _ "cmdMoveLast_Click" Exit Sub End Sub Private Sub cmdMoveNext_Click() On Error GoTo HandleError 'move to the next record in the local disconnected recordset Call MoveToNextRecord(intCurrContactRecord, rsContacts, objContacts, _ blnAddMode) 'populate the controls on the form with the current record Call PopulateContactsControls Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, CONTACTS_FORM, _ "cmdMoveNext_Click" Exit Sub End Sub Private Sub cmdMovePrevious_Click() On Error GoTo HandleError 'move to the previous record in the local disconnected recordset Call MoveToPreviousRecord(intCurrContactRecord, rsContacts, _ objContacts, blnAddMode) 'populate the controls on the form with the current record Call PopulateContactsControls Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, CONTACTS_FORM, _ "cmdMovePrevious_Click" Exit Sub End Sub
Add the following AddEmptyContactRecord procedure to the frmContacts form:
Sub AddEmptyContactRecord() On Error GoTo HandleError 'set add mode to true blnAddMode = True 'clear the current values in the contacts object objContacts.ClearObject 'clear the current controls on the form so the 'user can fill in values for the new record Call ClearContactsControls Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, CONTACTS_FORM, _ "AddEmptyContactRecord" Exit Sub End Sub
Add the following PopulateContactsControls procedure to the frmContacts form:
Sub PopulateContactsControls() On Error GoTo HandleError 'Populate the controls on the Contacts form with the values of the 'current record in the contacts object. If Not rsContacts.BOF And Not rsContacts.EOF Then Me.txtLName = objContacts.LastName Me.txtFName = objContacts.FirstName Me.txtMName = objContacts.MiddleName Me.txtCompany = objContacts.Company Me.txtAddress1 = objContacts.Address1 Me.txtAddress2 = objContacts.Address2 Me.txtCity = objContacts.City Me.txtRegion = objContacts.Region Me.txtPostalCode = objContacts.PostalCode Me.txtWorkPhone = objContacts.WorkPhone Me.txtHomePhone = objContacts.HomePhone Me.txtCellPhone = objContacts.CellPhone Me.txtEmail = objContacts.Email 'display the record count on the form lblRecordNum.Caption = "Record " & intCurrContactRecord & " Of " & _ rsContacts.RecordCount ElseIf rsContacts.BOF Then 'past beginning of recordset so move to first record Call MoveToFirstRecord(intCurrContactRecord, rsContacts, _ objContacts, blnAddMode) ElseIf rsContacts.EOF Then 'past end of recordset so move back to last record Call MoveToLastRecord(intCurrContactRecord, rsContacts, _ objContacts, blnAddMode) End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, CONTACTS_FORM, _ "PopulateContactsControls" Exit Sub End Sub
Add the following ClearContactsControls procedure to the frmContacts form:
Sub ClearContactsControls() On Error GoTo HandleError 'clear the values in the controls on the form Me.txtLName = "" Me.txtFName = "" Me.txtMName = "" Me.txtCompany = "" Me.txtAddress1 = "" Me.txtAddress2 = "" Me.txtCity = "" Me.txtRegion = "" Me.txtPostalCode = "" Me.txtWorkPhone = "" Me.txtHomePhone = "" Me.txtCellPhone = "" Me.txtEmail = "" Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, CONTACTS_FORM, _ "ClearContactsControls" Exit Sub End Sub
Add the following Form_Unload event to the frmContacts form:
Private Sub Form_Unload(Cancel As Integer) On Error GoTo HandleError 'close the recordset and free the memory rsContacts.Close Set rsContacts =Nothing Exit Sub HandleError: GeneralErrorHandler Err.Number,Err.Description,CONTACTS_FORM,_ "Form_Unload" Exit Sub End Sub
Congratulations - that’s all the code! Now take time to resolve any typographical errors, if you have not done so already. The next section will give you a tour of the most interesting features of the application.
How It Works
The last set of code you added for the project was for the frmContacts form. In the Form_Load event, you added code to initialize the form, for example, populating the contacts recordset with one or all contacts records:
Private Sub Form_Load() On Error GoTo HandleError Set objContacts =New clsContacts Set rsContacts =New ADODB.Recordset 'not in add mode blnAddMode =False intCurrContactRecord =0 Set rsContacts =objContacts.RetrieveContacts 'if the recordset is empty If rsContacts.BOF And rsContacts.EOF Then Exit Sub Else 'populate the object with values in the recordset objContacts.PopulatePropertiesFromRecordset rsContacts Call MoveToFirstRecord(intCurrContactRecord,rsContacts,_ objContacts, blnAddMode) 'populate the controls on the form with the current record Call PopulateContactsControls End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, CONTACTS_FORM, "Form_Load" Exit Sub End Sub
You also added the cmdAddToProject_Click event that is responsible for adding the selected contact to the current project record:
Private Sub cmdAddToProject_Click() On Error GoTo HandleError Dim strSQLStatement As String 'build the SQL statement to insert a new contact for the current 'project on frmProjects strSQLStatement = BuildSQLInsertProjectsContacts(objContacts.ContactId, _ intContactProjectAdd) 'insert the record into the database ProcessUpdate (strSQLStatement) Call Forms("frmProjects").RefreshContacts 'close the Contacts form to return the user to the Project streen DoCmd.Close acForm, "frmContacts" Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, CONTACTS_FORM, _ "cmdAddToProject_Click" Exit Sub End Sub
Similarly to what you did with frmProjects, you also added event procedures for the cmdAddNew, cmdSave, and cmdDelete buttons. For example, you added the cmdAddNew_Click event to put the form in add mode to allow the user to add a new contact to the database:
Private Sub cmdAddNew_Click() On Error GoTo HandleError 'clear the current controls to enable adding a new 'contact record Call AddEmptyContactRecord Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, CONTACTS_FORM, _ "cmdAddNew_Click" Exit Sub End Sub
Just as you did with the frmProjects form, you also added event procedures for navigating through the records. For example, the cmdMoveFirst_Click event moves to the first record in the local disconnected recordset and populates the controls on the form with the current record:
Private Sub cmdMoveFirst_Click() On Error GoTo HandleError 'move to the first record in the local disconnected recordset Call MoveToFirstRecord(intCurrContactRecord, rsContacts, _ objContacts, blnAddMode) 'populate the controls on the form with the current record Call PopulateContactsControls Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, CONTACTS_FORM, _ "cmdMoveFirst_Click" Exit Sub End Sub
You also created procedures for adding an empty contact record and for clearing the contacts controls on the form. Similarly, you added a procedure called PopulateContactsControls to populate the controls on the frmContacts form with the values of the current record in the objContacts object.
Sub PopulateContactsControls() On Error GoTo HandleError 'Populate the controls on the Contacts form with the values of the 'current record in the contacts object. If Not rsContacts.BOF And Not rsContacts.EOF Then Me.txtLName = objContacts.LastName Me.txtFName = objContacts.FirstName Me.txtMName = objContacts.MiddleName Me.txtCompany = objContacts.Company Me.txtAddress1 = objContacts.Address1 Me.txtAddress2 = objContacts.Address2 Me.txtCity = objContacts.City Me.txtRegion = objContacts.Region Me.txtPostalCode = objContacts.PostalCode Me.txtWorkPhone = objContacts.WorkPhone Me.txtHomePhone = objContacts.HomePhone Me.txtCellPhone = objContacts.CellPhone Me.txtEmail = objContacts.Email 'display the record count on the form lblRecordNum.Caption = "Record " & intCurrContactRecord & " Of " & _ rsContacts.RecordCount ElseIf rsContacts.BOF Then 'past beginning of recordset so move to first record Call MoveToFirstRecord(intCurrContactRecord, rsContacts, _ objContacts, blnAddMode) ElseIf rsContacts.EOF Then 'past end of recordset so move back to last record Call MoveToLastRecord(intCurrContactRecord, rsContacts, _ objContacts, blnAddMode) End If Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, CONTACTS_FORM, _ "PopulateContactsControls" Exit Sub End Sub
Finally, the Form_Unload event was added to the frmContacts form to close the rsContacts recordset and free the memory taken up by the recordset.
Private Sub Form_Unload(Cancel As Integer) On Error GoTo HandleError 'close the recordset and free the memory rsContacts.Close Set rsContacts = Nothing Exit Sub HandleError: GeneralErrorHandler Err.Number, Err.Description, CONTACTS_FORM, "Form_Unload" Exit Sub End Sub