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.

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