|
|
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).
 |
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:
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.
|
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:
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
|
|
|