I am trying to create a nested class in VBA.
So far I have successfully created the following:
OurCompany.Department.Employee("Jo
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
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