Adding Functionality with Classes in Microsoft VBA

Creating a Hierarchy of Classes

In this example, you look at creating a hierarchy of classes, which demonstrates the ability of classes to be used as building blocks for improving the design in managing data objects. The example involves a business problem for which the classes need to perform complex calculations (although you will stick to simple calculations in the example).

Suppose that you have analyzed an insurance company’s business, the result of which revealed that the company sells a large number of different insurance products, but you noticed that there are common features in the products. Often, one type of policy only differs from another in a small number of ways. The task is to build an Access application that assists with generating the policy documents and performing appropriate calculations for the different policies.

Creating a Base Class

The first task is to identify common features to all policies as well as the most standard calculations that a policy would require to perform. This involves creating a class, which will serve as the base class. In the following code, this is called clsPolicy.

From the project window in the VBA Editor, create a class module, and then save the module with the name clsPolicy, as demonstrated in the following code:

Option Compare Database
Option Explicit

' clsPolicy is the base class which has common features
' required in other classes

Dim p_MonthlyPremium As Currency

Public Property Get MonthlyPremium() As Currency
    MonthlyPremium = p_MonthlyPremium
End Property

Public Property Let MonthlyPremium(ByVal MonthlyPremium As Currency)
    p_MonthlyPremium = MonthlyPremium
End Property

Public Function CalculateAnnualPolicyValue() As Currency
    CalculateAnnualPolicyValue = p_MonthlyPremium * 12
End Function

This class can then be tested by using the following code:

Sub modInsurance_Policy()
    ' create a Policy from clsPolicy
    Dim Policy As New clsPolicy
    Policy.MonthlyPremium = 10
    ' Expect 120
    Debug.Print Policy.CalculateAnnualPolicyValue()
    Set Policy = Nothing
End Sub

Derived Classes

With the basic insurance policy class created, you can now create several other classes that will all use some of the base class features. This involves creating a class, which will serve as the derived class, and in the following code is called clsHomePolicy, being derived from the base class clsPolicy. The term derived is used because the class is in some way related or derived from the base class:

Option Compare Database
Option Explicit

' clsHomePolicy uses clsPolicy
Dim p_Policy As clsPolicy

Private Sub Class_Initialize()
    Set p_Policy = New clsPolicy
End Sub
Private Sub Class_Terminate()
    Set p_Policy = Nothing
End Sub

Public Property Get MonthlyPremium() As Currency
    MonthlyPremium = p_Policy.MonthlyPremium
End Property

Public Property Let MonthlyPremium(ByVal MonthlyPremium As Currency)
    p_Policy.MonthlyPremium = MonthlyPremium
End Property

Public Function CalculateAnnualPolicyValue() As Currency
    CalculateAnnualPolicyValue = p_Policy.CalculateAnnualPolicyValue() + 50
End Function

The first derived class, clsHomePolicy, contains a base class object, clsPolicy, so you need to have initialization and termination events to create and dispose of the base class object.

The clsHomePolicy is only loosely tied to clsPolicy, which means that you need to add all the required properties and methods into the new class. But if you look at the CalculateAnnualPolicyValue method, you will see how it can take advantage of the calculation in the base class.

As is illustrated in the code that follows, you can now define two additional classes, one called clsSpecialHomePolicy, which is derived from clsHomePolicy, and the other, called clsCarPolicy, is derived from clsPolicy (you can view the code in the sample database):

Option Compare Database
Option Explicit

' clsSpecialHomePolicy
Dim p_Policy As clsHomePolicy

Private Sub Class_Initialize()
    Set p_Policy = New clsHomePolicy
End Sub
Private Sub Class_Terminate()
    Set p_Policy = Nothing
End Sub

Public Property Get MonthlyPremium() As Currency
    MonthlyPremium = p_Policy.MonthlyPremium
End Property

Public Property Let MonthlyPremium(ByVal MonthlyPremium As Currency)
    p_Policy.MonthlyPremium = MonthlyPremium
End Property

Public Function CalculateAnnualPolicyValue() As Currency
    CalculateAnnualPolicyValue = p_Policy.CalculateAnnualPolicyValue() + 100
End Function

These classes can be tested with the following code:

Sub modInsurance_Policy()
    ' create a Policy from clsPolicy
    Dim Policy As New clsPolicy
    Policy.MonthlyPremium = 10
    ' Expect 120
    Debug.Print Policy.CalculateAnnualPolicyValue()
    Set Policy = Nothing

    ' create a HomePolicy
    Dim HomePolicy As New clsHomePolicy
    HomePolicy.MonthlyPremium = 10
    ' Expect 120+50 = 170
    Debug.Print HomePolicy.CalculateAnnualPolicyValue()
    Set HomePolicy = Nothing

    ' create a SpecialHomePolicy
    Dim SpecialHomePolicy As New clsSpecialHomePolicy
    SpecialHomePolicy.MonthlyPremium = 10
    ' Expect 120+50+100 = 270
    Debug.Print SpecialHomePolicy.CalculateAnnualPolicyValue()
    Set SpecialHomePolicy = Nothing

    ' create a CarPolicy
    Dim CarPolicy As New clsCarPolicy
    CarPolicy.MonthlyPremium = 10
    ' Expect 120+80 = 200
    Debug.Print CarPolicy.CalculateAnnualPolicyValue()
    Set CarPolicy = Nothing
End Sub