Excel VBA : Passing a collection from a class to a module issue

Question

我一直在尝试将集合从类中的属性返回到普通模块中的例程。我遇到的问题是，集合在类(FetchAll)的属性中正确填充，但是当我将集合传递回模块(测试)时，所有条目都将填充列表中的最后一项。

这是标准模块中的测试子例程:

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

这是 QueryType 类中的 FetchAll 属性:

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

这是我从 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

这是我从测试中调试得到的输出:

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

有人有什么想法吗？我可能完全忽略了一些事情!

谢谢，马丁

Answer 1

您创建的 QueryType:

Dim QType As New QueryType

应该是:

Dim QType As QueryType
Set QType = New QueryType

如果您不这样做，您将重复使用 QueryType 的相同实例(因为没有 Set)，因此相同的引用将添加到集合中，使每个项目引用您的类的单个实例。 (您添加的最后一个)