Excel VBA: передача коллекции из класса в проблему модуля - PullRequest
Новая
       14

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

3 голосов
/ 20 апреля 2010

Я пытался вернуть коллекцию из свойства в классе подпрограмме в обычном модуле. Проблема, с которой я сталкиваюсь, заключается в том, что коллекция правильно заполняется в свойстве класса (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

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

Спасибо, Martin

1 Ответ

2 голосов
/ 20 апреля 2010

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

Dim QType As New QueryType

Должно быть: 

Dim QType As QueryType
Set QType = New QueryType

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

...