I have noticed this question https://stackoverflow.com/questions/49389392/nested-classes-and-collections-vba in StackOverflow, but it got closed faster than I could have answered. However, it was concerning a best practice for usage of collections of classes.
I usually use Array
and I add to it like this:
Public Sub AddToTeam(emp As Employee)
Dim cnt As Long
cnt = UBound(pTeam)
If Not pTeam(0) Is Nothing Then
ReDim Preserve pTeam(cnt + 1)
cnt = cnt + 1
End If
Set pTeam(cnt) = emp
End Sub
Furthermore, I initialize the Array like this in the class:
Private Sub Class_Initialize()
ReDim pTeam(0)
End Sub
This is the working code, feel free to give any ideas:
Main Module
Option Explicit
Public Sub TestMe()
Dim EmpA As New Employee
Dim EmpB As New Employee
Dim ManA As New Employee
Dim TeamA As New Team
ManA.Name = "John Doe Top Manager"
EmpA.Name = "Peter"
EmpB.Name = "George"
Set EmpB.Manager = ManA
TeamA.Name = "The best team!"
TeamA.AddToTeam ManA
TeamA.AddToTeam EmpA
TeamA.AddToTeam EmpB
TeamA.PrintNames
Debug.Print TeamA.Name
TeamA.PrintInfoForManagers
End Sub
Class Employee
Option Explicit
Private pName As String
Private pManager As Employee
Private pAge As Long
Private pTeam As String
Private pHasManager As Boolean
Public Property Get HasManager() As Boolean
HasManager = pHasManager
End Property
Public Property Let HasManager(Value As Boolean)
pHasManager = Value
End Property
Public Property Get Manager() As Employee
Set Manager = pManager
End Property
Public Property Set Manager(Value As Employee)
Set pManager = Value
HasManager = True
End Property
Public Property Get Name() As String
Name = pName
End Property
Public Property Let Name(Value As String)
pName = Value
End Property
Public Property Get Team() As Employee
Team = pTeam
End Property
Public Property Let Team(Value As Employee)
pTeam = Value
End Property
Class Team
Option Explicit
Private pTeam() As Employee
Private pName As String
Public Sub PrintInfoForManagers()
Dim emp As Variant
For Each emp In pTeam
If emp.HasManager Then
Debug.Print emp.Name & " is managed by " & emp.Manager.Name
Else
Debug.Print emp.Name & " has no manager."
End If
Next emp
End Sub
Public Sub PrintNames()
Dim emp As Variant
For Each emp In pTeam
Debug.Print emp.Name
Next emp
End Sub
Public Property Get Name() As String
Name = pName
End Property
Public Property Let Name(Value As String)
pName = Value
End Property
Public Sub AddToTeam(emp As Employee)
Dim cnt As Long
cnt = UBound(pTeam)
If Not pTeam(0) Is Nothing Then
ReDim Preserve pTeam(cnt + 1)
cnt = cnt + 1
End If
Set pTeam(cnt) = emp
End Sub
Private Sub Class_Initialize()
ReDim pTeam(0)
End Sub
So how would you review/improve it?