Building the Class Modules for the Objects

Throughout this book you learned that VBA code can be written in various places, such as class modules that are independent or associated with a form, as well as in standard modules. Next, you turn your attention to writing the code that will implement the desired features of the Project Tracker application. You will be creating the custom class modules first, then the standard modules, and finally the code for the forms to call the other modules. An example of how the Project Explorer will look in the Visual Basic Editor when you’re finished is shown in Figure 13-23.

image from book
Figure 13-23

Chapter 4 introduced the idea of creating custom classes. In the current application, you will create two logical custom class modules. One is a class for a Project object that will represent the current project in memory on the Project Tracker screen. The other will be a Contact object that will represent any current contact in memory from the Contacts screen.

The Project Class

An object diagram for the Project class is shown in Figure 13-24.

Tip

The Contact class will be illustrated later in this chapter.

Project
- ProjectID - ProjectTitle - ProjectDescription - Priority - ReferenceNum - MoneyBudget - MoneytoDate - HoursBudget - HourstoDate - DateDue - Status
+ Save () + Delete () + RetrieveProjects () + RetrieveComments () + RetrieveContacts () + RetrieveAttachments () + PopulatePropertiesFromRecordset () + PopulatePropertiesFromForm () + ClearObject ()

Figure 13-24

The properties are represented in the top portion of the diagram, and the methods are shown in the bottom section. These correspond to the data elements on the form for the most part, except that the tabs with multiple records are not listed here. The methods represent various actions that you must take on the object. You will also write numerous other procedures that are not in the class module, as you will see later.

Try It Out-Building the clsProjects Class

Let’s begin building the clsProjects class module that will implement the object illustrated in Figure 13-24.

Before building the class, you first need to add a reference to ADO (preferably 2.6 or higher) by selecting Tools, References, and then selecting ADO 2.6 from the list.

Add a new class module called clsProjects. In the General Declarations section of the class, add the following code:

  Option Compare Database Option Explicit Const CLS_PROJECTS As String = "clsProjects" Dim intProjectIdVal As Integer Dim strProjectTitleVal As String Dim strProjectDescriptionVal As String Dim strPriorityVal As String Dim strReferenceNumVal As String Dim curMoneyBudgetVal As Currency Dim curMoneyToDateVal As Currency Dim intHoursBudgetVal As Integer Dim intHoursToDateVal As Integer Dim dtDateDueVal As Date Dim strStatusVal As String

Add the various property procedures shown in the following code to clsProjects class module:

   Public Property Get ProjectId() As Integer      On Error Resume Next      ProjectId = intProjectIdVal  End Property       Public Property Let ProjectId(ByVal Value As Integer)      On Error Resume Next      intProjectIdVal = Value  End Property   Public Property Get ProjectTitle() As String      On Error Resume Next      ProjectTitle = strProjectTitleVal  End Property       Public Property Let ProjectTitle(ByVal Value As String)      On Error Resume Next      strProjectTitleVal = Value  End Property Public Property Get ProjectDescription() As String      On Error Resume Next      ProjectDescription = strProjectDescriptionVal  End Property       Public Property Let ProjectDescription(ByVal Value As String)      On Error Resume Next      strProjectDescriptionVal = Value  End Property  Public Property Get Priority() As String     On Error Resume Next     Priority = strPriorityVal End Property      Public Property Let Priority(ByVal Value As String)     On Error Resume Next      strPriorityVal = Value  End Property   Public Property Get ReferenceNum() As String      On Error Resume Next      ReferenceNum = strReferenceNumVal  End Property  Public Property Let ReferenceNum(ByVal Value As String)      On Error Resume Next      strReferenceNumVal = Value  End Property  Public Property Get MoneyBudget() As Currency      On Error Resume Next      MoneyBudget = curMoneyBudgetVal  End Property       Public Property Let MoneyBudget(ByVal Value As Currency)      On Error Resume Next      curMoneyBudgetVal = Value  End Property  Public Property Get MoneyToDate() As Currency      On Error Resume Next      MoneyToDate = curMoneyToDateVal  End Property       Public Property Let MoneyToDate(ByVal Value As Currency)      On Error Resume Next      curMoneyToDateVal = Value  End Property  Public Property Get HoursBudget() As Integer      On Error Resume Next      HoursBudget = intHoursBudgetVal  End Property    Public Property Let HoursBudget(ByVal Value As Integer)      On Error Resume Next      intHoursBudgetVal = Value  End Property   Public Property Get HoursToDate() As Integer      On Error Resume Next      HoursToDate = intHoursToDateVal  End Property       Public Property Let HoursToDate(ByVal Value As Integer)      On Error Resume Next      intHoursToDateVal = Value  End Property  Public Property Get DateDue() As Date      On Error Resume Next      DateDue = dtDateDueVal  End Property  Public Property Let DateDue(ByVal Value As Date)      On Error Resume Next      dtDateDueVal = Value  End Property  Public Property Get Status() As String      On Error Resume Next      Status = strStatusVal  End Property       Public Property Let Status(ByVal Value As String)      On Error Resume Next      strStatusVal = Value  End Property

Add the RetrieveProjects function shown in the following code to the clsProjects class module:

  Function RetrieveProjects(blnAllRecords As Boolean) As ADODB.Recordset    On Error GoTo HandleError    Dim strSQLStatement As String    Dim rsProj As New ADODB.Recordset    'build the SQL statement to retrieve data    strSQLStatement = BuildSQLSelectProjects(blnAllRecords)    'generate the recordset    Set rsProj = ProcessRecordset(strSQLStatement)    'return the populated recordset    Exit Function HandleError:    GeneralErrorHandler Err.Number, Err.Description, CLS_PROJECTS, _           "RetrieveProjects"    Exit Function End Function

Add the RetrieveComments function shown in the following code to the clsProjects class module:

  Function RetrieveComments(intId As Integer) As ADODB.Recordset    On Error GoTo HandleError    Dim rsComments As New ADODB.Recordset    Dim strSQL As String    strSQL = "SELECT txtComment FROM tblProjectsComments WHERE " & _             "intProjectId = " &_intId    'retrieve the comments for tab 1 from the database    Set rsComments = ProcessRecordset(strSQL)        Set RetrieveComments = rsComments        Exit Function    HandleError:    GeneralErrorHandler Err.Number, Err.Description, CLS_PROJECTS, _           "RetrieveComments"    Exit Function  End Function

Add the RetrieveContacts function shown in the following code to the clsProjects class module:

  Function RetrieveContacts(intId As Integer) As ADODB.Recordset     On Error GoTo HandleError     Dim rsContacts As New ADODB.Recordset     Dim strSQL As String     strSQL = "SELECT txtFirstName, txtLastName, txtWorkPhone, txtHomePhone, " &        "txtCellPhone, txtEmail, tblcontacts.intContactId FROM tblContacts " & _        "INNER JOIN tblProjectsContacts ON " & _        "tblContacts.intContactId = tblProjectsContacts.intContactId " & _        "WHERE tblProjectsContacts.intProjectId = " & intId    'retrieve the comments for tab 2 from the database    Set rsContacts = ProcessRecordset(strSQL)    Set RetrieveContacts = rsContacts        Exit Function    HandleError:    GeneralErrorHandler Err.Number, Err.Description, CLS_PROJECTS, _          "RetrieveContacts"   Exit Function End Function

Add the RetrieveAttachments function shown in the following code to the clsProjects class module:

  Function RetrieveAttachments(intId As Integer) As ADODB.Recordset     On Error GoTo HandleError    Dim rsAttachments As New ADODB.Recordset    Dim strSQL As String        strSQL = "SELECT txtFileDescription, txtFileName " & _        "FROM tblProjectsFileAttachments WHERE intProjectId = " & intId    'retrieve the comments for tab 3 from the database    Set rsAttachments = ProcessRecordset(strSQL)        Set RetrieveAttachments = rsAttachments        Exit Function    HandleError:     GeneralErrorHandler Err.Number, Err.Description, CLS_PROJECTS, _           "RetrieveAttachments"     Exit Function  End Function

Add the PopulatePropertiesFromRecordset procedure shown in the following code to the clsProjects class module:

  Sub PopulatePropertiesFromRecordset(rsProj As ADODB.Recordset)     On Error GoTo HandleError    'Populate the object with the current record in the    'recordset    Me.ProjectId = rsProj!intProjectId    Me.ProjectTitle = rsProj!txtProjectTitle    Me.ProjectDescription = rsProj!txtProjectDescription    Me.Priority = rsProj!txtPriority    Me.ReferenceNum = rsProj!txtReferenceNum    Me.MoneyBudget = rsProj!curMoneyBudget    Me.MoneyToDate = rsProj!curMoneyToDate    Me.HoursBudget = rsProj!intHoursBudget    Me.HoursToDate = rsProj!intHoursToDate    Me.DateDue = rsProj!dtDateDue    Me.Status = rsProj!txtStatus    Exit Sub HandleError:    GeneralErrorHandler Err.Number, Err.Description, CLS_PROJECTS, _         "PopulatePropertiesFromRecordset"    Exit Sub  End Sub

Add the PopulatePropertiesFromForm procedure shown in the following code to the clsProjects class module:

  Sub PopulatePropertiesFromForm()     On Error GoTo HandleError     'Populate the object with the current record in the     'form     If Forms("frmProjects")!txtProjectId <> "" Then         Me.ProjectId = CInt(Forms("frmProjects")!txtProjectId)     End If     Me.ProjectTitle = Forms("frmProjects")!txtProjectTitle     Me.ProjectDescription = Forms("frmProjects")!txtProjectDesc     Me.Priority = Forms("frmProjects")!cboPriority     Me.ReferenceNum = Forms("frmProjects")!txtReferenceNum     If Forms("frmProjects")!txtMoneyBudget <> "" Then         Me.MoneyBudget = CCur(Forms("frmProjects")!txtMoneyBudget)     End If     If Forms("frmProjects")!txtMoneyToDate <> "" Then         Me.MoneyToDate = CCur(Forms("frmProjects")!txtMoneyToDate)     End If     If Forms("frmProjects")!txtHoursBudget <> "" Then         Me.HoursBudget = CInt(Forms("frmProjects")!txtHoursBudget)     End If     If Forms("frmProjects")!txtHoursToDate <> "" Then         Me.HoursToDate = CInt(Forms("frmProjects")!txtHoursToDate)     End If     If Forms("frmProjects")!txtDateDue <> "" Then         Me.DateDue = CDate(Forms("frmProjects")!txtDateDue)     End If     Me.Status = Forms("frmProjects")!cboStatus     Exit Sub  HandleError:    GeneralErrorHandler Err.Number, Err.Description, CLS_PROJECTS, _           "PopulatePropertiesFromForm"    Exit Sub End Sub

Add the ClearObject procedure shown in the following code to the clsProjects class module:

   Sub ClearObject()      On Error GoTo HandleError     'clear the values in the projects object     Me.ProjectId = 0     Me.ProjectTitle = ""     Me.ProjectDescription = ""     Me.Priority = 0     Me.ReferenceNum = ""     Me.MoneyBudget = 0     Me.MoneyToDate = 0     Me.HoursBudget = 0     Me.HoursToDate = 0     Me.DateDue = "01-01-1900"     Me.Status = 0     Exit Sub  HandleError:      GeneralErrorHandler Err.Number, Err.Description, CLS_PROJECTS, "ClearObject"      Exit Sub End Sub

Add the Delete procedure shown in the following code to the clsProjects class module:

  Sub Delete(intCurProjId As Integer, blnAddMode As Boolean, rsProj As _            ADODB.Recordset)     On Error GoTo HandleError     Dim strSQLStatement As String     Dim intResponse As Integer     'make sure delete should be processed     If Not ProceedWithDelete(blnAddMode) Then       Exit Sub     End If     'build the SQL statement to delete the project     strSQLStatement = BuildSQLDeleteProjects(intCurProjId)     'perform the delete     Call ProcessUpdate(strSQLStatement, rsProj)        Exit Sub HandleError:     GeneralErrorHandler Err.Number, Err.Description, CLS_PROJECTS, "Delete"     Exit Sub End Sub

Add the Save procedure shown in the following code to the clsProjects class module:

  Sub Save(blnAddMode As Boolean, rsProj As ADODB.Recordset)     On Error GoTo HandleError     Dim strSQLStatement As String     'if adding a new record     If blnAddMode = True Then         strSQLStatement = BuildSQLInsertProjects(Me)     Else         'if updating a record         strSQLStatement = BuildSQLUpdateProjects(Me)     End If     'perform the insert or update     Call ProcessUpdate(strSQLStatement, rsProj)     Exit Sub HandleError:     GeneralErrorHandler Err.Number, Err.Description, CLS_PROJECTS, "Save"     Exit Sub End Sub

How It Works

To build the clsProjects class module that implements the object illustrated in Figure 13-24, you first added code to the General Declarations section of the new class. For example, you declared various local variables for storing the current value of each property:

 Dim intProjectIdVal As Integer Dim strProjectTitleVal As String Dim strProjectDescriptionVal As String Dim strPriorityVal As String Dim strReferenceNumVal As String Dim curMoneyBudgetVal As Currency Dim curMoneyToDateVal As Currency Dim intHoursBudgetVal As Integer Dim intHoursToDateVal As Integer Dim dtDateDueVal As Date Dim strStatusVal As String

Next, you added various Get and Let property procedures that will allow retrieving and setting the values in the respective property. A few of these property procedures are shown again in the following code:

 Public Property Get ProjectId() As Integer      On Error Resume Next      ProjectId = intProjectIdVal End Property Public Property Let ProjectId(ByVal Value As Integer)      On Error Resume Next      intProjectIdVal = Value End Property Public Property Get ProjectTitle() As String      On Error Resume Next      ProjectTitle = strProjectTitleVal End Property Public Property Let ProjectTitle(ByVal Value As String)     On Error Resume Next     strProjectTitleVal = Value End Property

After the properties for the class module were added, you added various sub procedures and functions to serve as the methods for the class. For example, the RetrieveProjects function is used to retrieve the project records from the database that will be displayed on the frmProjects form.

   Function RetrieveProjects(blnAllRecords As Boolean) As ADODB.Recordset        On Error GoTo HandleError           Dim strSQLStatement As String     Dim rsProj As New ADODB.Recordset           'build the SQL statement to retrieve data     strSQLStatement = BuildSQLSelectProjects(blnAllRecords)           'generate the recordset     Set rsProj = ProcessRecordset(strSQLStatement)           'return the populated recordset     Set RetrieveProjects = rsProj         Exit Function HandleError:     GeneralErrorHandler Err.Number, Err.Description, CLS_PROJECTS, _             "RetrieveProjects"     Exit Function  End Function

Functions were also added to retrieve the comments, contacts, and attachment records associated with a particular project from the tblProjectsComments, tblProjectsContacts, and tblProjectsFile Attachments tables. For example, the RetrieveComments function declares a new recordset to store the results from the database. It then specifies the SQL statement that should be used to retrieve the records for the particular project and calls a ProcessRecord function that will actually populate the recordset by executing the SQL statement against the database. The RetrieveContacts and RetrieveAttachments functions work in a similar fashion.

 Function RetrieveComments(intId As Integer) As ADODB.Recordset On Error GoTo HandleError    Dim rsComments As New ADODB.Recordset    Dim strSQL As String   strSQL = "SELECT txtComment FROM tblProjectsComments WHERE intProjectId = " & _             intId    'retrieve the comments for tab 1 from the database    Set rsComments = ProcessRecordset(strSQL)    Set RetrieveComments = rsComments    Exit Function    HandleError:    GeneralErrorHandler Err.Number, Err.Description, CLS_PROJECTS, _           "RetrieveComments"    Exit Function  End Function

Next, you added two procedures that populate the properties of the class. The first procedure, PopulatePropertiesFromRecordset, populates the properties of the class from values in the rsProj recordset. After the recordset has been populated with the project records, the values for the current project must be loaded into the clsProject object and ultimately displayed on the form to the user.

 Sub PopulatePropertiesFromRecordset(rsProj As ADODB.Recordset)    On Error GoTo HandleError    'Populate the object with the current record in the    'recordset    Me.ProjectId = rsProj!intProjectId    Me.ProjectTitle = rsProj!txtProjectTitle    Me.ProjectDescription = rsProj!txtProjectDescription    Me.Priority = rsProj!txtPriority    Me.ReferenceNum = rsProj!txtReferenceNum    Me.MoneyBudget = rsProj!curMoneyBudget    Me.MoneyToDate = rsProj!curMoneyToDate    Me.HoursBudget = rsProj!intHoursBudget

    Me.HoursToDate = rsProj!intHoursToDate    Me.DateDue = rsProj!dtDateDue    Me.Status = rsProj!txtStatus       Exit Sub HandleError:    GeneralErrorHandler Err.Number, Err.Description, CLS_PROJECTS, _         "PopulatePropertiesFromRecordset"    Exit Sub  End Sub

Similarly, the PopulatePropertiesFromForm procedure populates the properties of the object with the values currently in the controls on the form. To avoid a data conversion error, some statements first test to make sure the field on the form is not blank before assigning a value.

 Sub PopulatePropertiesFromForm()     On Error GoTo HandleError    'Populate the object with the current record in the    'form    If Forms("frmProjects")!txtProjectId <> "" Then        Me.ProjectId = CInt(Forms("frmProjects")!txtProjectId)    End If    Me.ProjectTitle = Forms("frmProjects")!txtProjectTitle    Me.ProjectDescription = Forms("frmProjects")!txtProjectDesc    Me.Priority = Forms("frmProjects")!cboPriority    Me.ReferenceNum = Forms("frmProjects")!txtReferenceNum    If Forms("frmProjects")!txtMoneyBudget <> "" Then        Me.MoneyBudget = CCur(Forms("frmProjects")!txtMoneyBudget)    End If    If Forms("frmProjects")!txtMoneyToDate <> "" Then        Me.MoneyToDate = CCur(Forms("frmProjects")!txtMoneyToDate)    End If    If Forms("frmProjects")!txtHoursBudget <> "" Then        Me.HoursBudget = CInt(Forms("frmProjects")!txtHoursBudget)    End If    If Forms("frmProjects")!txtHoursToDate <> "" Then        Me.HoursToDate = CInt(Forms("frmProjects")!txtHoursToDate)    End If    If Forms("frmProjects")!txtDateDue <> "" Then        Me.DateDue = CDate(Forms("frmProjects")!txtDateDue)

    End If    Me.Status = Forms("frmProjects")!cboStatus    Exit Sub HandleError:     GeneralErrorHandler Err.Number, Err.Description, CLS_PROJECTS, _            "PopulatePropertiesFromForm"     Exit Sub  End Sub

In addition to adding procedures that populate the object, you also added a procedure that clears all of the values in the object. The ClearObject procedure changes all the values in the object to initialization values so that the object can be reused for another project record.

 Sub ClearObject()      On Error GoTo HandleError     'clear the values in the projects object     Me.ProjectId = 0     Me.ProjectTitle = ""     Me.ProjectDescription = ""     Me.Priority = 0     Me.ReferenceNum = ""     Me.MoneyBudget = 0     Me.MoneyToDate = 0     Me.HoursBudget = 0     Me.HoursToDate = 0     Me.DateDue = "01-01-1900"     Me.Status = 0     Exit Sub  HandleError:      GeneralErrorHandler Err.Number, Err.Description, CLS_PROJECTS, "ClearObject"      Exit Sub End Sub

The final two procedures you added to the clsProjects class module included the Delete and Save procedures. The Delete procedure is responsible for deleting a particular project record from the database after confirming the user wishes to continue.

 Sub Delete(intCurProjId As Integer, blnAddMode As Boolean, rsProj As _            ADODB.Recordset)     On Error GoTo HandleError     Dim strSQLStatement As String

     Dim intResponse As Integer       'make sure delete should be processed     If Not ProceedWithDelete(blnAddMode) Then       Exit Sub     End If     'build the SQL statement to delete the project     strSQLStatement = BuildSQLDeleteProjects(intCurProjId)     'perform the delete     Call ProcessUpdate(strSQLStatement, rsProj)         Exit Sub HandleError:     GeneralErrorHandler Err.Number, Err.Description, CLS_PROJECTS, "Delete"     Exit Sub End Sub

The Save procedure is responsible for saving the new or updated record to the database:

 Sub Save(blnAddMode As Boolean, rsProj As ADODB.Recordset)      On Error GoTo HandleError         Dim strSQLStatement As String

If a new record is being added, the appropriate SQL insert statement is generated:

 'if adding a new record If blnAddMode = True Then     strSQLStatement = BuildSQLInsertProjects(Me) Else

If an existing record is being updated, the appropriate SQL update statement is generated:

 'if updating a record     strSQLStatement = BuildSQLUpdateProjects(Me) End If

The ProcessUpdate procedure is then executed so the SQL statement for the insert or update will be executed against the database:

    'perform the insert or update    Call ProcessUpdate(strSQLStatement, rsProj)        Exit Sub HandleError:

GeneralErrorHandler Err.Number, Err.Description, CLS_PROJECTS, "Save"

Exit Sub

End Sub

The Contact Class

An object diagram for the Contacts class is shown in Figure 13-25. The Contacts class has properties that correspond to those data elements, such as those shown on the Contacts form, as well as some methods that can be executed upon it.

Contact
-ContactId - LastName -FirstName - MiddleName -Company - Address1 - Address2 - City - Region - PostalCode -WorkPhone -HomePhone - CellPhone -Email
+Save () +Delete() +RetrieveContacts () +PopulatePropertiesFromRecordset() +PopulatePropertiesFromForm() +ClearObject()

Figure 13-25

Try It Out-Building the clsContacts Class

Let’s get started and build the clsContacts class module that will implement the object illustrated in Figure 13-25:

Create a new class module and name it clsContacts. Add the following code to the General Declarations section of the class:

  Option Compare Database Option Explicit Const CLS_CONTACTS As String = "clsContacts" Dim intContactIdVal As Integer Dim strLastNameVal As String Dim strFirstNameVal As String Dim strMiddleNameVal As String Dim strCompanyVal As String Dim strAddress1Val As String Dim strAddress2Val As String Dim strCityVal As String Dim strRegionVal As String Dim strPostalCodeVal As String Dim strWorkPhoneVal As String Dim strHomePhoneVal As String Dim strCellPhoneVal As String Dim strEmailVal As String

Add the property procedures shown in the following code to the clsProjects class module:

  Public Property Get ContactId() As Integer     On Error Resume Next     ContactId = intContactIdVal End Property     Public Property Let ContactId(ByVal Value As Integer)     On Error Resume Next     intContactIdVal = Value End Property Public Property Get LastName() As String     On Error Resume Next     LastName = strLastNameVal End Property     Public Property Let LastName(ByVal Value As String)     On Error Resume Next     strLastNameVal = Value End Property Public Property Get FirstName() As String     On Error Resume Next     FirstName = strFirstNameVal End Property     Public Property Let FirstName(ByVal Value As String)     On Error Resume Next     strFirstNameVal = Value End Property Public Property Get MiddleName() As String     On Error Resume Next     MiddleName = strMiddleNameVal End Property     Public Property Let MiddleName(ByVal Value As String)     On Error Resume Next     strMiddleNameVal = Value End Property Public Property Get Company() As String     On Error Resume Next     Company = strCompanyVal End Property Public Property Let Company(ByVal Value As String)     On Error Resume Next     strCompanyVal = Value End Property Public Property Get Address1() As String     On Error Resume Next     Address1 = strAddress1Val End Property Public Property Let Address1(ByVal Value As String)     On Error Resume Next     strAddress1Val = Value End Property Public Property Get Address2() As String     On Error Resume Next     Address2 = strAddress2Val End Property Public Property Let Address2(ByVal Value As String)     On Error Resume Next     strAddress2Val = Value End Property Public Property Get City() As String     On Error Resume Next     City = strCityVal End Property Public Property Let City(ByVal Value As String)     On Error Resume Next     strCityVal = Value End Property Public Property Get Region() As String     On Error Resume Next     Region = strRegionVal End Property Public Property Let Region(ByVal Value As String)     On Error Resume Next     strRegionVal = Value End Property Public Property Get PostalCode() As String     On Error Resume Next     PostalCode = strPostalCodeVal End Property Public Property Let PostalCode(ByVal Value As String)     On Error Resume Next     strPostalCodeVal = Value End Property Public Property Get WorkPhone() As String     On Error Resume Next     WorkPhone = strWorkPhoneVal End Property Public Property Let WorkPhone(ByVal Value As String)     On Error Resume Next     strWorkPhoneVal = Value End Property Public Property Get HomePhone() As String     On Error Resume Next     HomePhone = strHomePhoneVal End Property Public Property Let HomePhone(ByVal Value As String)     On Error Resume Next     strHomePhoneVal = Value End Property Public Property Get CellPhone() As String     On Error Resume Next     CellPhone = strCellPhoneVal End Property Public Property Let CellPhone(ByVal Value As String)     On Error Resume Next     strCellPhoneVal = Value End Property Public Property Get Email() As String     On Error Resume Next     Email = strEmailVal End Property Public Property Let Email(ByVal Value As String)     On Error Resume Next     strEmailVal = Value End Property

Add the RetrieveContacts function shown in the following code to the clsProjects class module:

  Function RetrieveContacts() As ADODB.Recordset     On Error GoTo HandleError         Dim strSQLStatement As String     Dim rsCont As New ADODB.Recordset     'build the SQL statement to retrieve data     strSQLStatement = BuildSQLSelectContacts     'generate the recordset     Set rsCont = ProcessRecordset(strSQLStatement)     'return the populated recordset     Set RetrieveContacts = rsCont     Exit Function HandleError:     GeneralErrorHandler Err.Number, Err.Description, CLS_CONTACTS, _            "RetrieveContacts"     Exit Function End Function

Add the PopulatePropertiesFromRecordset procedure shown in the following code to the clsProjects class module:

  Sub PopulatePropertiesFromRecordset(rsCont As ADODB.Recordset)     On Error GoTo HandleError     'Populate the object with the current record in the     'recordset     Me.ContactId = rsCont!intContactId     Me.LastName = rsCont!txtLastName     Me.FirstName = rsCont!txtFirstName     Me.MiddleName = rsCont!txtMiddleName     Me.Company = rsCont!txtCompany     Me.Address1 = rsCont!txtAddress1     Me.Address2 = rsCont!txtAddress2     Me.City = rsCont!txtCity     Me.Region = rsCont!txtRegion     Me.PostalCode = rsCont!txtPostalCode     Me.WorkPhone = rsCont!txtWorkPhone     Me.HomePhone = rsCont!txtHomePhone     Me.CellPhone = rsCont!txtCellPhone     Me.Email = rsCont!txtEmail     Exit Sub HandleError:     GeneralErrorHandler Err.Number, Err.Description, CLS_CONTACTS, _            "PopulatePropertiesFromRecordset"     Exit Sub End Sub

Add the PopulatePropertiesFromForm procedure shown in the following code to the clsProjects class module:

  Sub PopulatePropertiesFromForm()     On Error GoTo HandleError     'Populate the object with the current record in the     'form     Me.LastName = Forms("frmContacts")!txtLName     Me.FirstName = Forms("frmContacts")!txtFName     Me.MiddleName = Forms("frmContacts")!txtMName     Me.Company = Forms("frmContacts")!txtCompany     Me.Address1 = Forms("frmContacts")!txtAddress1     Me.Address2 = Forms("frmContacts")!txtAddress2     Me.City = Forms("frmContacts")!txtCity     Me.Region = Forms("frmContacts")!txtRegion     Me.PostalCode = Forms("frmContacts")!txtPostalCode     Me.WorkPhone = Forms("frmContacts")!txtWorkPhone     Me.HomePhone = Forms("frmContacts")!txtHomePhone     Me.CellPhone = Forms("frmContacts")!txtCellPhone     Me.Email = Forms("frmContacts")!txtEmail     Exit Sub HandleError:     GeneralErrorHandler Err.Number, Err.Description, CLS_CONTACTS, _            "PopulatePropertiesFromForm"     Exit Sub  End Sub

Add the ClearObject procedure shown in the following code to the clsProjects class module:

  Sub ClearObject()     On Error GoTo HandleError     'clear the values in the contacts object     Me.ContactId = 0     Me.LastName = ""     Me.FirstName = ""     Me.MiddleName = ""     Me.Company = ""     Me.Address1 = ""     Me.Address2 = ""     Me.City = ""     Me.Region = ""     Me.PostalCode = ""     Me.WorkPhone = ""     Me.HomePhone = ""     Me.CellPhone = ""     Me.Email = ""     Exit Sub HandleError:     GeneralErrorHandler Err.Number, Err.Description, CLS_CONTACTS,            "ClearObject"     Exit Sub End Sub

Add the Delete procedure shown in the following code to the clsProjects class module:

  Sub Delete(intCurContId As Integer, blnAddMode As Boolean, rsCont As _            ADODB.Recordset)     On Error GoTo HandleError     Dim strSQLStatement As String     Dim intResponse As Integer     'make sure delete should be processed     If Not ProceedWithDelete(blnAddMode) Then       Exit Sub     End If     'build the SQL statement to delete the contact     strSQLStatement = BuildSQLDeleteContacts(intCurContId)     'perform the delete     Call ProcessUpdate(strSQLStatement, rsCont)     Exit Sub HandleError:     GeneralErrorHandler Err.Number, Err.Description, CLS_CONTACTS, "Delete"     Exit Sub End Sub

Add the Save procedure shown in the following code to the clsProjects class module:

  Sub Save(blnAddMode As Boolean, rsCont As ADODB.Recordset)     On Error GoTo HandleError     Dim strSQLStatement As String     'if adding a new record     If blnAddMode = True Then         strSQLStatement = BuildSQLInsertContacts(Me)     Else         'if updating a record         strSQLStatement = BuildSQLUpdateContacts(Me)     End If     'perform the insert or update     Call ProcessUpdate(strSQLStatement, rsCont)     Exit Sub HandleError:     GeneralErrorHandler Err.Number, Err.Description, CLS_CONTACTS, "Save"     Exit Sub End Sub

Make sure to keep saving your changes periodically so they are not lost.

How It Works

The design of the clsContacts class module is similar to that of the clsProjects class module. You first added various local variables to the General Declarations section of the class for storing various property values:

 Dim intContactIdVal As Integer Dim strLastNameVal As String Dim strFirstNameVal As String Dim strMiddleNameVal As String Dim strCompanyVal As String Dim strAddress1Val As String Dim strAddress2Val As String Dim strCityVal As String Dim strRegionVal As String Dim strPostalCodeVal As String Dim strWorkPhoneVal As String Dim strHomePhoneVal As String Dim strCellPhoneVal As String Dim strEmailVal As String

Next, you added various Get and Let property procedures that are used to retrieve and assign values to the properties of the class:

 Public Property Get ContactId() As Integer     On Error Resume Next     ContactId = intContactIdVal End Property Public Property Let ContactId(ByVal Value As Integer)     On Error Resume Next     intContactIdVal = Value End Property Public Property Get LastName() As String     On Error Resume Next     LastName = strLastNameVal End Property Public Property Let LastName(ByVal Value As String)     On Error Resume Next     strLastNameVal = Value End Property

Next, various sub procedures and functions were added to serve as methods for the object. For example, the RetrieveContacts function retrieves the contacts records from the database:

 Function RetrieveContacts() As ADODB.Recordset     On Error GoTo HandleError     Dim strSQLStatement As String     Dim rsCont As New ADODB.Recordset     'build the SQL statement to retrieve data     strSQLStatement = BuildSQLSelectContacts     'generate the recordset     Set rsCont = ProcessRecordset(strSQLStatement)     'return the populated recordset     Set RetrieveContacts = rsCont         Exit Function HandleError:     GeneralErrorHandler Err.Number, Err.Description, CLS_CONTACTS, _            "RetrieveContacts"     Exit Function End Function

The PopulatePropertiesFromRecordset procedure populated the properties of the object from the values in the rsCont recordset:

 Sub PopulatePropertiesFromRecordset(rsCont As ADODB.Recordset)     On Error GoTo HandleError     'Populate the object with the current record in the     'recordset     Me.ContactId = rsCont!intContactId     Me.LastName = rsCont!txtLastName     Me.FirstName = rsCont!txtFirstName     Me.MiddleName = rsCont!txtMiddleName     Me.Company = rsCont!txtCompany     Me.Address1 = rsCont!txtAddress1

     Me.Address2 = rsCont!txtAddress2     Me.City = rsCont!txtCity     Me.Region = rsCont!txtRegion     Me.PostalCode = rsCont!txtPostalCode     Me.WorkPhone = rsCont!txtWorkPhone     Me.HomePhone = rsCont!txtHomePhone     Me.CellPhone = rsCont!txtCellPhone     Me.Email = rsCont!txtEmail     Exit Sub HandleError:     GeneralErrorHandler Err.Number, Err.Description, CLS_CONTACTS, _            "PopulatePropertiesFromRecordset"     Exit Sub End Sub

Similarly, the PopulatePropertiesFromForm procedure populated the contacts object with the values currently displayed in the controls on the form:

 Sub PopulatePropertiesFromForm()     On Error GoTo HandleError     'Populate the object with the current record in the     'form     Me.LastName = Forms("frmContacts")!txtLName     Me.FirstName = Forms("frmContacts")!txtFName     Me.MiddleName = Forms("frmContacts")!txtMName     Me.Company = Forms("frmContacts")!txtCompany     Me.Address1 = Forms("frmContacts")!txtAddress1     Me.Address2 = Forms("frmContacts")!txtAddress2     Me.City = Forms("frmContacts")!txtCity     Me.Region = Forms("frmContacts")!txtRegion     Me.PostalCode = Forms("frmContacts")!txtPostalCode     Me.WorkPhone = Forms("frmContacts")!txtWorkPhone     Me.HomePhone = Forms("frmContacts")!txtHomePhone     Me.CellPhone = Forms("frmContacts")!txtCellPhone     Me.Email = Forms("frmContacts")!txtEmail     Exit Sub HandleError:     GeneralErrorHandler Err.Number, Err.Description, CLS_CONTACTS, _            "PopulatePropertiesFromForm"     Exit Sub  End Sub

A ClearObject procedure was added to reset the values in the object to the initial values so that a new contact record could be stored in the object:

 Sub ClearObject()     On Error GoTo HandleError     'clear the values in the contacts object     Me.ContactId = 0     Me.LastName = ""     Me.FirstName = ""     Me.MiddleName = ""     Me.Company = ""     Me.Address1 = ""     Me.Address2 = ""     Me.City = ""     Me.Region = ""     Me.PostalCode = ""     Me.WorkPhone = ""     Me.HomePhone = ""     Me.CellPhone = ""     Me.Email = ""     Exit Sub HandleError:     GeneralErrorHandler Err.Number, Err.Description, CLS_CONTACTS, _            "ClearObject"     Exit Sub End Sub

Finally, Delete and Save procedures were added so that the user can delete and save contact records in the database. The Delete procedure first confirms that the user wishes to proceed with the deletion, and then, upon confirmation, proceeds with the delete:

 Sub Delete(intCurContId As Integer, blnAddMode As Boolean, rsCont As _            ADODB.Recordset)     On Error GoTo HandleError     Dim strSQLStatement As String     Dim intResponse As Integer     'make sure delete should be processed     If Not ProceedWithDelete(blnAddMode) Then       Exit Sub     End If     'build the SQL statement to delete the contact     strSQLStatement = BuildSQLDeleteContacts(intCurContId)     'perform the delete

     Call ProcessUpdate(strSQLStatement, rsCont)     Exit Sub HandleError:     GeneralErrorHandler Err.Number, Err.Description, CLS_CONTACTS, "Delete"     Exit Sub End Sub

The Save procedure first checks to see if a new record is being added, and if so, generates the proper SQL insert statement. If an existing record is being updated, the proper SQL update statement is generated.

 Sub Save(blnAddMode As Boolean, rsCont As ADODB.Recordset)     On Error GoTo HandleError     Dim strSQLStatement As String     'if adding a new record     If blnAddMode = True Then         strSQLStatement = BuildSQLInsertContacts(Me)     Else         'if updating a record         strSQLStatement = BuildSQLUpdateContacts(Me)     End If

The ProcessUpdate procedure is then called so the SQL insert or update statement is executed against the database.

     'perform the insert or update     Call ProcessUpdate(strSQLStatement, rsCont)     Exit Sub HandleError:     GeneralErrorHandler Err.Number, Err.Description, CLS_CONTACTS, "Save"     Exit Sub End Sub