Collection Class

[Hap]

I am trying to create a read only property in a class module that functions similar to the worksheets object in the Excel model. The worksheet property in Excel only references one collection of Sheets. How can I emulate this behavior? I will have two Classes one called Structures which will be the collection and one called Structure which will be the objects in the collection.

Thanks for any direction on this!!!

 

[Hermanito]

Hey there, this is a subject where it is difficult to find good info about... I have struggled with this before and I will show you a sample of a simple User class, a collection class, and how to use them in the rest of the code...
I'm sure you can adapt this to what you need, but feel free to ask questions if something is not clear...

The User class (I called it clsUser), must be a Class module of course:

Option Explicit

Private m_Id As String
Private m_FirstName As String
Private m_LastName As String

Public Property Get Id() As String
    Id = m_Id
End Property
Public Property Let Id(Value As String)
    m_Id = Value
End Property

Public Property Get FirstName() As String
    FirstName = m_FirstName
End Property
Public Property Let FirstName(Value As String)
    m_FirstName = Value
End Property

Public Property Get LastName() As String
    LastName = m_LastName
End Property
Public Property Let LastName(Value As String)
    m_LastName = Value
End Property

Public Property Get FullName() As String
    FullName = LastName & ", " & FirstName
    If LastName = "" Or FirstName = "" Then
        FullName = Replace(FullName, ", ", "")
    End If
End Property

Public Property Get Initials() As String
    Initials = ""
    If LastName <> "" Then Initials = Initials & Left$(LastName, 1) & "."
    If FirstName <> "" Then Initials = Initials & Left$(FirstName, 1) & "."
End Property

The interesting bit, the collection class (called clsUsers), also a Class module:

Option Explicit
Private m_clsUsers As Collection

Private Sub Class_Initialize()
    Set m_clsUsers = New Collection
End Sub
Private Sub Class_Terminate()
    Set m_clsUsers = Nothing
End Sub
Public Function Add(ByVal Value As clsUser)
    Call m_clsUsers.Add(Value, CStr(Value.Id))
End Function
Public Property Get Items() As Collection
    Set Items = m_clsUsers
End Property
Public Property Get Item(ByVal Value As String) As clsUser
    Set Item = m_clsUsers(Value)
End Property
Public Sub Remove(ByVal Value As String)
    Call m_clsUsers.Remove(Value)
End Sub
Public Sub Clear()
    Dim TmpItem As clsUser
    For Each TmpItem In Me.Items
        Me.Remove TmpItem
    Next TmpItem
End Sub
Public Function Exists(ByVal Value As String) As Boolean
    Dim TmpItem As clsUser
    Exists = False
    For Each TmpItem In Me.Items
        If (TmpItem.Id = Value) Then
            Exists = True
        End If
    Next TmpItem
End Function

You're of course free to implement more methods in your collection class, but this shows how to add the standard behaviors for a collection.

Then, an example of how to use it (in this case on a userform, using a list of users as a collection object, to fill a listview on the form):

Private Sub FillUserList()
    If m_UserList Is Nothing Then Exit Sub
    If m_UserList.Items.COUNT = 0 Then Exit Sub
    Dim ctl As clsUser
    lstUsers.ListItems.Clear
    For Each ctl In m_UserList.Items
        If ctl.Id <> "0" Then
            Dim lvi As ListItem
            Set lvi = lstUsers.ListItems.Add(, , ctl.FullName)
            Call AddUserDetails(ctl, lvi)
        End If
    Next
End Sub

The m_Userlist has previously been declared as clsUsers like this:
Dim m_Userlist as clsUsers
and filled with clsUser objects in a different part of the code.
The AddUserDetails sub just fills in the extra columns of the listview for each user.

Notice how I have to use m_Userlist.Items to be able to use For Each. There is a way to avoid having to use the .Items by making it the default property of the Collection, but that is a bit tricky (it involves exporting your class module to a .cls file, editing the textfile, and re-importing it), so I usually skip it, because it is not really necessary...

Edit: here's how to fill a collection with objects, thought that might help a bit too:

    Dim RowCounter As Long
    For RowCounter = 1 To UBound(queryResults, 1)
        Set ctl = New clsUser
        With ctl
            ctl.Id = queryResults(RowCounter, 1)
            ctl.FirstName = queryResults(RowCounter, 2)
            ctl.LastName = queryResults(RowCounter, 3)
        End With
        ctls.Add ctl
    Next RowCounter

ctl is a variable of type clsUser
ctls is a variable of type clsUsers
queryResults is an array filled with the results from a .... surprise surprise... query

 

[Hap]

This is awesome. Thank you much. I'll implement and let you know how it works out!!

 

[Hap]

As an extension of this concept I am including additional collection objects in my structure object. Each structure will have these objects in them so does it make sense to create them in the initialize method of the parent object or create them in the initialize method of each additional collection class object?

Seems to me the concept of OOP is to contain everything in its own class so my inclination is to create each collection in its own class.

Thank you

 

[Hermanito]

I would also keep the instantiation of the private Collection field in the initialize methods of those collections, like in the sample code I provided.
You will need to instantiate the collection class in the initialize method of the Structure class as well though, because they are object variables, not value variables.

So you will have extra collection classes, but in your Structure class you can have things like this:

Private m_SomeCollection As clsSomeCollection

Public Property Get SomeCollection() As clsSomeCollection
    [COLOR="Red"][B]Set[/B][/COLOR] SomeCollection= m_SomeCollection 
End Property
Public Property [B][COLOR="Red"]Set [/COLOR][/B]Id(Value As clsSomeCollection)
    [COLOR="Red"][B]Set[/B][/COLOR] m_SomeCollection = Value
End Property

Private Sub Class_Initialize()
    Set m_SomeCollection = New clsSomeCollection
End Sub
Private Sub Class_Terminate()
    Set m_SomeCollection = Nothing
End Sub

Notice the extra Set keywords you will need when dealing with an object variable in the getter/setter functions.