Excel VBA: Passing a collection from a class to a module issue
- by Martin
Hello,
I have been trying to return a collection from a property within a class to a routine in a normal module. The issue I am experiencing is that the collection is getting populated correctly within the property in the class (FetchAll) but when I pass the collection back to the module (Test) all the entries are populated with the last item in the list.
This is the Test sub-routine in the standard module:
Sub Test()
Dim QueryType As New QueryType
Dim Item
Dim QueryTypes As Collection
Set QueryTypes = QueryType.FetchAll
For Each Item In QueryTypes
Debug.Print Item.QueryTypeID, _
Left(Item.Description, 4)
Next Item
End Sub
This is the FetchAll property in the QueryType class:
Public Property Get FetchAll() As Collection
Dim RS As Variant
Dim Row As Long
Dim QTypeList As Collection
Set QTypeList = New Collection
RS = .Run ' populates RS with a record set from a database (as an array),
' some code removed
' goes through the array and sets up objects for each entry
For Row = LBound(RS, 2) To UBound(RS, 2)
Dim QType As New QueryType
With QType
.QueryTypeID = RS(0, Row)
.Description = RS(1, Row)
.Priority = RS(2, Row)
.QueryGroupID = RS(3, Row)
.ActiveIND = RS(4, Row)
End With
' adds new QType to collection
QTypeList.Add Item:=QType, Key:=CStr(RS(0, Row))
Debug.Print QTypeList.Item(QTypeList.Count).QueryTypeID, _
Left(QTypeList.Item(QTypeList.Count).Description, 4)
Next Row
Set FetchAll = QTypeList
End Property
This is the output I get from the debug in FetchAll:
1 Numb
2 PBM
3 BPM
4 Bran
5 Claw
6 FA C
7 HNW
8 HNW
9 IFA
10 Manu
11 New
12 Non
13 Numb
14 Repo
15 Sell
16 Sms
17 SMS
18 SWPM
This is the output I get from the debug in Test:
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
18 SWPM
Anyone got any ideas? I am probably totally overlooking something!
Thanks,
Martin
