Excel VBA: Передача коллекции от класса к проблеме модуля

Question

Я пытаюсь вернуть коллекцию из свойства внутри класса в подпрограмму в нормальном модуле. Проблема, которую я испытываю, заключается в том, что коллекция правильно заполняется в свойстве класса (FetchAll), но когда я передаю коллекцию обратно в модуль (Test), все записи заполняются последним элементом в списке.

Это тест подпрограммой в стандартном модуле:

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 

Это свойство 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 

У кого-нибудь есть идеи? Я, наверное, совершенно ничего не замечаю!

Спасибо, Martin

Answer 1

Ваше создание тип_запроса:

Dim QType As New QueryType 

Должно быть:

Dim QType As QueryType 
Set QType = New QueryType 

Если вы не сделаете это, вы повторно используете один и тот же экземпляр QueryType (поскольку нет Set), поэтому в сборник добавляется одна и та же ссылка, что делает каждую ссылку на один экземпляр вами r класс. (Последний добавленный вами)