Excel VBA: передача коллекции из класса в выпуск модуля

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

Это подпрограмма 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 в классе QueryType:

 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 

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

Спасибо, Мартин

Ваше создание QueryType:

 Dim QType As New QueryType 

Должно быть:

 Dim QType As QueryType Set QType = New QueryType 

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

  • VBA | Как создать модуль класса, который строит объекты и назначает их массиву / коллекции
  • VBA - работа с get / let по какой-то причине не будет установлена
  • Как правильно работать с коллекцией модулей класса VBA?
  • Ошибка VBA 424 при попытке использовать метод класса из другого модуля
  • Давайте будем гением компьютера.