Glenn G
Glenn G

Reputation: 667

How to Enumerate more than 1 Collection in VBA Class Module

I have two different collections in my class module that I'd like to enumerate. However, it doesn't seem to work. I could use an array for one of the collections, but this would make my use of the class much more difficult to code for elsewhere.

Is this even possible? If so, what do I have wrong?

I've tried searching google and can't seem to find a lot of information on this.

clsPart:

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsPart"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private iPart As String
Private Type tSeqs
    SequenceNumbers As Collection
    RouterSequences As Collection
End Type
Private cc1 As tSeqs

Public Property Get SeqNumbers() As IUnknown
Attribute SeqNumbers.VB_UserMemId = -4
Attribute SeqNumbers.VB_MemberFlags = "40"
    Set SeqNumbers = cc1.SequenceNumbers.[_SeqNumbers]
End Property

Public Property Get RouterSeqs() As IUnknown
Attribute RouterSeqs.VB_UserMemId = -4
Attribute RouterSeqs.VB_MemberFlags = "40"
    Set RouterSeqs = cc1.RouterSequences.[_RouterSeqs]
End Property

Private Sub Class_Initialize()
    With cc1
        Set .SequenceNumbers = New Collection
        Set .RouterSequences = New Collection
    End With
End Sub

Private Sub Class_Terminate()
    With cc1
        Set .SequenceNumbers = Nothing
        Set .RouterSequences = Nothing
    End With
End Sub

Public Property Get PartNumber() As String
    PartNumber = iPart
End Property

Public Property Let PartNumber(lPart As String)
    iPart = lPart
End Property

Public Sub AddSequence(ByVal aSeq As String, ByVal aQty As Double)
    Dim iSeq As clsSeq
        If SeqExists(aSeq) Then
            Set iSeq = cc1.SequenceNumbers.Item(aSeq)
            iSeq.Qty = iSeq.Qty + aQty
        Else
            Set iSeq = New clsSeq
            With iSeq
                .Qty = aQty
                .Sequence = aSeq
            End With
            With cc1
                .SequenceNumbers.Add iSeq, iSeq.Sequence
                .RouterSequences.Add iSeq.Sequence
                SortSeqColl .RouterSequences
            End With
        End If
        Set iSeq = Nothing
End Sub

Public Function SequenceExists(ByVal Index As String)
    SequenceExists = SeqExists(Index)
End Function

Public Function Sequence(ByVal Index As String) As clsSeq
    Set Sequence = cc1.SequenceNumbers.Item(Index)
End Function

Private Function SeqExists(iSeq As String) As Boolean
    Dim V As Variant
        On Error Resume Next
        V = IsObject(cc1.SequenceNumbers.Item(iSeq))
        SeqExists = Not IsEmpty(V)
End Function

Private Sub SortSeqColl(ByRef sColl As Collection)
    Dim vItm As Variant
    Dim i As Long, j As Long
    Dim vTemp As Variant
        For i = 1 To sColl.Count - 1
            For j = i + 1 To sColl.Count
                If sColl(i) > sColl(j) Then
                    vTemp = sColl(j)
                    sColl.Remove j
                    sColl.Add vTemp, vTemp, i
                End If
            Next j
        Next i
End Sub

The first collection is specific information about that particular part (qty at each of the manufacturing stages that it is currently at) The second collection is just a list of all the possible sequence numbers (stages of manufacture) that the part could possibly be at, this changes with each different part. When referencing the data on actual qty and location in the manufacturing process, I need to be able to check in reverse order of the manufacturing process to pull qtys from the most complete first.

Upvotes: 2

Views: 219

Answers (1)

Mathieu Guindon
Mathieu Guindon

Reputation: 71187

Your collection class is both a SequenceCollection and a RouterCollection.

This cannot work:

Set RouterSeqs = cc1.RouterSequences.[_RouterSeqs]

Or this:

Set SeqNumbers = cc1.SequenceNumbers.[_SeqNumbers]

Bring up the Object Browser (hit F2); right-click somewhere and select "show hidden members", then find the VBA.Collection class - you'll see this:

VBA.Collection hidden _NewEnum member

That hidden _NewEnum member is what's yielding the IUnknown enumerator that For Each is consuming. It's not a made-up member name!

Change your RouterSeqs property to return it:

Set RouterSeqs = cc1.RouterSequences.[_NewEnum]

Same for SeqNumbers:

Set SeqNumbers = cc1.SequenceNumbers.[_NewEnum]

The square brackets are needed, because the _ prefix makes _NewEnum an invalid identifier as far as VBA is concerned; the square brackets make it parse as a "foreign identifier", which is supported.

Now, let's picture some imaginary client code:

Public Sub EnumerateParts(ByVal parts As clsPart)
    Dim part As Object
    For Each part In parts
        '...
    Next
End Sub

If the clsPart class (protip: a collection class should have a pluralized name) has two properties that enable For Each enumeration, then how is VBA supposed to guess which one to use?

It can't.

Pick one to be the collection class' enumerator, and name it NewEnum to stick with convention - ditch the other.

Note that VBA will not honor this flag:

Attribute SeqNumbers.VB_MemberFlags = "40"

Because members cannot be hidden in VBA user code (should work fine in VB6 though).

Upvotes: 1

Related Questions