Collections of Collections
David Morton wrote ...
Before I waste my time trying to figure out how to do it, is it possible to
make collections of collections of data? I have a system that has several
different items listed under one larger item, which is, in turn, part of a
group of like items. I suppose a query on a cost of a part would look
something like this:
? BigCollection("SerialNumber").Part("PartNumber").C ost
Is it possible to put my objects in heirarchial stages like that?
I think the term for this code construct is 'tunnelling'. I'm a great
fan of this kind of object model design. When implementing, I find it
easiest to have a parent class. For example:
m_Schema.Tables("MyTable").Columns("MyCol1").Name
This requires five classes:
CSchema
CTables
CTable
CColumns
CColumn
CSchema is the parent class. It has a property Tables, which returns
an instances of the CTables collection class (essentially a wrapper
for a underlying Collection object). CTables has an Item property
(wraps the Collection's Item method) which returns and instance of
CTable held in the Collection. CTable has a Columns property which
returns a CColumns object which has an Item property etc etc.
Excel is at a couple of a disadvantages over VB6.0 here. First, to get
the nice neat tunnelling as above, the Item property of the collection
classes must be the default member of the class, otherwise you'd have
to use the slightly less satisfactory:
m_Schema.Tables.Item("MyTable").Columns.Item(1).Na me
There is no native way of specifying the default value doing this in
Excel VBA but there is a 'hack': export the class, add the magic line
using a text editor then reimport to Excel.
Another disadvantage of Excel is that classes types are limited to
Private and PublicNotCreatable. Ideally, I'd like the parent CSchema
to be the only class in the model that can be instantiated:
Private m_Schema As CSchema
...
Set m_Schema = New CSchema
The child CTable class would only be creatable using:
Dim oTable As CTable
Set oTable m_Schema.Tables.Add(<required arguments)
Think of the Excel object model: you can't create a worksheet using:
Dim ws As Excel.Worksheet
Set ws = New Excel.Worksheet
but you can use:
Dim ws As Excel.Worksheet
Set ws = ThisWorkbook.Worksheets.Add
Although object creation cannot be restricted in this way use custom
classes, it remains a good model to follow.
The following is the bare essentials of the five classes and some code
to test the classes. To 'hack' the default member for the collection
classes (CTables and CColumns), follow the embedded instructions.
' <In a standard module ---
Option Explicit
Private m_Schema As CSchema
Sub Test()
Set m_Schema = New CSchema
m_Schema.Tables.Add("MyTable1").Columns.Add "MyCol1"
m_Schema.Tables(1).Columns.Add "MyCol2"
Dim oTable As CTable
Set oTable = m_Schema.Tables.Add("MyTable2")
oTable.Columns.Add "MyCol1"
oTable.Columns.Add "MyCol2"
oTable.Columns.Add "MyCol3"
MsgBox m_Schema.Tables("MyTable1").Columns(1).Name
MsgBox m_Schema.Tables(2).ColumnListDelimited
End Sub
' </In a standard module ---
' <CSchema ---
Option Explicit
Private m_Tables As CTables
Public Property Get Tables() As CTables
Set Tables = m_Tables
End Property
Private Sub Class_Initialize()
Set m_Tables = New CTables
End Sub
' </CSchema ---
' <CTables ---
Option Explicit
Private m_colTables As Collection
Public Property Get Item(ByVal Index As Variant) As CTable
'Attribute Item.VB_UserMemId = 0
' *** Export to a file, uncomment the above Attribute line using
' a text editor then re-import ***
On Error Resume Next
Set Item = m_colTables.Item(Index)
End Property
Public Property Get NewEnum() As IUnknown
'Attribute NewEnum.VB_UserMemId = -4
'Attribute NewEnum.VB_MemberFlags = "40"
' *** Export to a file, uncomment the above two Attribute lines using
' a text editor then re-import ***Set NewEnum =
m_colColumns.[_NewEnum]
Set NewEnum = m_colTables.[_NewEnum]
End Property
Friend Function Add(ByVal Name As String) As CTable
Dim oTable As CTable
Set oTable = New CTable
oTable.Init Name
m_colTables.Add oTable, Name
Set Add = oTable
End Function
Friend Property Get Count() As Long
Count = m_colTables.Count
End Property
Friend Function Remove(ByVal Index As Variant) As Boolean
On Error Resume Next
m_colTables.Remove Index
Remove = (Err.Number = 0)
End Function
Private Sub Class_Initialize()
Set m_colTables = New Collection
End Sub
' </CTables ---
' <CTable ---
Option Explicit
Private m_Columns As CColumns
Private m_strName As String
Private Sub Class_Initialize()
Set m_Columns = New CColumns
End Sub
Public Property Get Name() As String
Name = m_strName
End Property
Friend Function Init( _
ByVal Name As String _
) As Boolean
m_strName = Name
Init = True
End Function
Public Property Get Columns() As CColumns
Set Columns = m_Columns
End Property
Public Property Get ColumnListDelimited( _
Optional Delimiter As String = ", " _
) As String
Dim oColumn As CColumn
Dim strReturn As String
If Columns.Count < 1 Then
Exit Property
End If
For Each oColumn In m_Columns
strReturn = strReturn & oColumn.Name & Delimiter
Next
' Remove trailing delimiter
strReturn = Left$(strReturn, Len(strReturn) - Len(Delimiter))
ColumnListDelimited = strReturn
End Property
' </CTable ---
' <CColumns ---
Option Explicit
Private m_colColumns As Collection
Public Property Get Item(ByVal Index As Variant) As CColumn
'Attribute Item.VB_UserMemId = 0
' *** Export to a file, uncomment the above Attribute line using
' a text editor then re-import ***
On Error Resume Next
Set Item = m_colColumns.Item(Index)
End Property
Public Property Get NewEnum() As IUnknown
'Attribute NewEnum.VB_UserMemId = -4
'Attribute NewEnum.VB_MemberFlags = "40"
' *** Export to a file, uncomment the above two Attribute lines using
' a text editor then re-import ***Set NewEnum =
m_colColumns.[_NewEnum]
Set NewEnum = m_colColumns.[_NewEnum]
End Property
Friend Function Add( _
ByVal Name As String _
) As CColumn
Dim oColumn As CColumn
Set oColumn = New CColumn
oColumn.Init Name
m_colColumns.Add oColumn, Name
Set Add = oColumn
End Function
Friend Property Get Count() As Long
Count = m_colColumns.Count
End Property
Friend Function Remove(ByVal Index As Variant) As Boolean
On Error Resume Next
m_colColumns.Remove Index
Remove = (Err.Number = 0)
End Function
Private Sub Class_Initialize()
Set m_colColumns = New Collection
End Sub
' </CColumns ---
' <CColumn ---
Option Explicit
Private m_strName As String
Public Property Get Name() As String
Name = m_strName
End Property
Friend Function Init( _
ByVal Name As String _
) As Boolean
m_strName = Name
Init = True
End Function
' </CColumn ---
Jamie.
--
|