Creating Nested Class

Question

I am trying to create a nested class in VBA.

So far I have successfully created the following:

OurCompany.Department.Employee("John")

How can I create a few groups of Department so I can store the data seperately. Something like this

OurCompany.Department("Finance").Employee("John") = "Employee Number 100"
OurCompany.Department("Finance").Employee("Kim") = "Employee Number 101"
OurCompany.Department("Engineering").Employee("Sam") = "Employee Number 124"

cDeparment Class

Private pDepartmentEmployee As Collection
Public Property Get Department(RefString As String) As cEmployee

    Set Department = pDepartment.Item(RefString)

End Property

Public Property Set Department(RefString As String, ByVal objDepartEmployee As cEmployee)

    pDepartmentEmployee.Add objDepartEmployee, RefString

End Property

cEmployee Class

Private pEmployee As Collection
Public Property Get Employee(RefKey As String) As String

    Employee = pEmployee.Item(RefKey)

End Property

Public Property Let Employee(RefKey As String, RefItem As String)

    pEmployee.Add Item:=RefItem, Key:=RefKey

End Property

It is very unclear what your problem is. Please expand some more. — Vegard, Jul 07 '17 at 08:33
What you show as `cDeparment Class` seems to be the `cCompany class`, isn't it? — A.S.H, Jul 07 '17 at 08:49

Kostas K. · Accepted Answer · 2019-10-11T11:15:18.537

I strongly suggest to read the answer in this post including any attached references.

Nevertheless, a simple implementation could be as follows.

Company Class:

Option Explicit
Private mDepartmentsList As Object

Public Property Get Department(ByVal StringKey As String) As Department
    With mDepartmentsList
        If Not .Exists(StringKey) Then
            Dim objDepartment As New Department
            .Add StringKey, objDepartment
        End If
    End With

    Set Department = mDepartmentsList(StringKey)
End Property

Public Property Get Keys() As Variant
    Keys = mDepartmentsList.Keys
End Property

Private Sub Class_Initialize()
    Set mDepartmentsList = CreateObject("Scripting.Dictionary")
End Sub

Private Sub Class_Terminate()
    Set mDepartmentsList = Nothing
End Sub

Department Class:

Option Explicit
Private mEmployeesList As Object

Public Property Get Employee(ByVal StringKey As String) As String
    Employee = mEmployeesList(StringKey)
End Property

Public Property Let Employee(ByVal StringKey As String, ByVal StringValue As String)
    mEmployeesList(StringKey) = StringValue
End Property

Public Property Get Keys() As Variant
    Keys = mEmployeesList.Keys
End Property

Private Sub Class_Initialize()
    Set mEmployeesList = CreateObject("Scripting.Dictionary")
End Sub

Private Sub Class_Terminate()
    Set mEmployeesList = Nothing
End Sub

Testing:

Option Explicit

Sub TestCompanyClass()

    Dim OurCompany As Company
    Set OurCompany = New Company

    With OurCompany
        .Department("Finance").Employee("John") = "Employee Number 100"
        .Department("Finance").Employee("Kim") = "Employee Number 101"
        .Department("Engineering").Employee("Sam") = "Employee Number 124"
    End With

    Dim d As Variant, e As Variant
    With OurCompany
        For Each d In .Keys
            Debug.Print "Department: " & d
            For Each e In .Department(d).Keys
                Debug.Print vbTab & "Employee: " & e & " - " & .Department(d).Employee(e)
            Next e
        Next d
    End With

    Set OurCompany = Nothing
End Sub

Output:

Department: Finance
    Employee: John - Employee Number 100
    Employee: Kim - Employee Number 101
Department: Engineering
    Employee: Sam - Employee Number 124

Thanks for your help, the program work well. There is 1 part i do not understand though, why isnt there any Set/Let in Company Class? My current way of thinking, if we are writing data into the class: OurCompany.Department("Finance").Employee("John") = "Employee Number 100" Shouldn't there be a Set/Let in the Company Class? — FlyFly Wing, Jul 09 '17 at 02:46
If you look closely, upon request (property Get) a new department object is created and added to the Collection if it doesn't exist. In simple words, I need this object from the collection, does it exist? Yes, return it. No? Create one, add it to the collection and return it. If you had a Set property, the department object would have to be declared in advanced and Set to OurCompany object. — Kostas K., Jul 09 '17 at 06:20
tk you very much for the knowledge, I will study it further. Right now I am trying to make it initialize all the information in the excel sheet so I can extract the information by just inserting the RefString into the Department(RefString) — FlyFly Wing, Jul 10 '17 at 08:42

Daniel Dušek · Answer 2 · 2017-07-08T11:55:48.007

Here you could create object model with classes like this:

Company -> has Departments -> Department -> has Employees -> Employee

To create wrapper classes like Departments and Employees may seen to be purposeless but consider the fact that the VBA.Collection can hold anything not just only instances of Department or Employee so this way the collection wrapper ensures, that the collection holds only objects of certain type.

Dim col As VBA.Collection
Set col = New VBA.Collection

col.Add 123, CStr(123)
col.Add Range("A1:C3"), "Range(""A1:C3"")"
col.Add "banana", "banana"

Dim wing As Employee
Set wing = New Employee
wing.Id = 200
wing.Name = "Wing"

col.Add wing, CStr(wing.Id)

Debug.Print col.Count ' Prints 4

Simple example, HTH.

Company

Private m_departmets As Departmets

Public Property Get Departmets() As Departmets
    Set Departmets = m_departmets
End Property

Private Sub Class_Initialize()
    Set m_departmets = New Departmets
End Sub

Departments

Private m_items As VBA.Collection

Private Sub Class_Initialize()
    Set m_items = New VBA.Collection
End Sub

Public Sub AddItem(newItem As Department)
    m_items.Add newItem, newItem.Name
End Sub

Public Function GetItem(Name As String) As Department
    Set GetItem = m_items(Name)
End Function

Department

Private m_name As String
Private m_employees As Employees

Public Property Get Name() As String
    Name = m_name
End Property

Public Property Let Name(ByVal vNewValue As String)
    m_name = vNewValue
End Property

Public Property Get Employees() As Employees
    Set Employees = m_employees
End Property

Private Sub Class_Initialize()
    Set m_employees = New Employees
End Sub

Employees

Private m_items As VBA.Collection

Private Sub Class_Initialize()
    Set m_items = New VBA.Collection
End Sub

Public Sub AddItem(newItem As Employee)
    m_items.Add newItem, VBA.CStr(newItem.Id)
End Sub

Public Function GetItem(Id As Long) As Employee
    Set GetItem = m_items(VBA.CStr(Id))
End Function

Employee

Private m_name As String
Private m_id As Long

Public Property Get Name() As String
    Name = m_name
End Property

Public Property Let Name(ByVal vNewValue As String)
    m_name = vNewValue
End Property

Public Property Get Id() As Long
    Id = m_id
End Property

Public Property Let Id(ByVal vNewValue As Long)
    m_id = vNewValue
End Property

Test

Sub Test()
    Dim john As Employee
    Dim kim As Employee
    Dim sam As Employee
    Dim financeDepartment As Department
    Dim engineeringDepartment As Department
    Dim ourCompany As Company

    Set john = New Employee
    Set kim = New Employee
    Set sam = New Employee

    john.Name = "John"
    john.Id = 100
    kim.Name = "Kim"
    kim.Id = 101
    sam.Name = "Sam"
    sam.Id = 124

    Set financeDepartment = New Department
    Set engineeringDepartment = New Department

    financeDepartment.Name = "Finance"
    engineeringDepartment.Name = "Engineering"

    financeDepartment.Employees.AddItem john
    financeDepartment.Employees.AddItem kim
    engineeringDepartment.Employees.AddItem sam

    Set ourCompany = New Company
    ourCompany.Departmets.AddItem financeDepartment
    ourCompany.Departmets.AddItem engineeringDepartment

    Debug.Print ourCompany.Departmets.GetItem("Finance").Employees.GetItem(100).Name
    Debug.Print ourCompany.Departmets.GetItem("Finance").Employees.GetItem(101).Name
    Debug.Print ourCompany.Departmets.GetItem("Engineering").Employees.GetItem(124).Name

    ' Change name of Sam to Samuel
    ourCompany.Departmets.GetItem("Engineering").Employees.GetItem(124).Name = "Samuel"
    Debug.Print ourCompany.Departmets.GetItem("Engineering").Employees.GetItem(124).Name
End Sub

Output

John
Kim
Sam
Samuel

Creating Nested Class

2 Answers2

Linked