ms-access - MS Access VBA：将多个对象添加到集合中

Question

我正在尝试将多个对象添加到集合中。

我有几个循环构建和填充我的对象，然后将对象添加到集合中。

问题是，当我观看集合时，它显示所有对象都是相同的，而不是每个对象都具有构建它们的记录中的数据。

我该如何纠正？我需要在重建下一个对象之前解构我的对象吗？

Public Sub processPurchases()

'DB Connection
Dim dbs As Database
Set dbs = CurrentDb
Dim rstPurchases As Recordset
Set rstPurchases = dbs.OpenRecordset("qryPurchasesByCardHolder")

'Decalre Variables
Dim counter As Integer
Dim iteration As Integer
Dim bCode As String
Dim transDate As String
Dim ven As String
Dim amt As String
Dim req As String
Dim desc As String
Dim Purchases As New Collection
iteration = 0

If rstPurchases.RecordCount > 0 Then
    rstPurchases.MoveFirst
    Do While Not rstPurchases.EOF
        iteration = iteration + 1
        counter = 0
        Do While counter < 11
            counter = counter + 1
            Dim p As String
            p = ("Purchase" & iteration & "-" & counter)
            Dim Purchase As New clsPurchaseItem
            bCode = "budgetCode" & counter
            transDate = "transDate" & counter
            ven = "vendor" & counter
            amt = "amount" & counter
            req = "requestedBy" & counter
            desc = "description" & counter
            If Not rstPurchases.Fields(bCode).value = "" Then
                MsgBox p
                Purchase.CardHolderID = rstPurchases.Fields("cardEmpId").value
                MsgBox "Card Holder ID: " & Purchase.CardHolderID

                Purchase.CardHolderName = rstPurchases.Fields("cardName").value
                MsgBox "Card Holder Name: " & Purchase.CardHolderName

                Purchase.StatementDate = rstPurchases.Fields("currDate").value
                MsgBox "Statement Date: " & Purchase.StatementDate

                Purchase.Department = rstPurchases.Fields("deptname").value
                MsgBox "Department: " & Purchase.Department

                Purchase.BudgetCode = rstPurchases.Fields(bCode).value
                MsgBox "Budget Code: " & Purchase.BudgetCode

                Purchase.TransactionDate = rstPurchases.Fields(transDate).value
                MsgBox "Transaction Date: " & Purchase.TransactionDate

                Purchase.Vendor = rstPurchases.Fields(ven).value
                MsgBox "Vendor:" & Purchase.Vendor

                Purchase.Amount = rstPurchases.Fields(amt).value
                MsgBox "Purchase Amount: " & Purchase.Amount

                Purchase.RequestedBy = rstPurchases.Fields(req).value
                MsgBox "Requested By: " & Purchase.RequestedBy

                Purchase.Description = rstPurchases.Fields(desc).value
                MsgBox "Description: " & Purchase.Description

                Purchases.Add Purchase, p
            End If
        Loop
        rstPurchases.MoveNext
        MsgBox "Move To Next Record"
    Loop
End If
 MsgBox Purchases.Item("Purchase2-1").Description
End Sub

标签： ms-accessvba

Answer 1

问题是你使用Dim As New

Dim Purchase As New clsPurchaseItem可能看起来与Dim Purchase As clsPurchaseItemand相同Set Purchase = clsPurchaseItem，但事实并非如此。它只初始化Purchase一次，并让它处于一种奇怪的、坚不可摧的状态。

正如 Victor K 所说，您需要手动设置它。但是您还需要摆脱Dim As New：

Public Sub processPurchases()

'DB Connection
Dim dbs As Database
Set dbs = CurrentDb
Dim rstPurchases As Recordset
Set rstPurchases = dbs.OpenRecordset("qryPurchasesByCardHolder")

'Decalre Variables
Dim counter As Integer
Dim iteration As Integer
Dim bCode As String
Dim transDate As String
Dim ven As String
Dim amt As String
Dim req As String
Dim desc As String
Dim Purchases As New Collection
iteration = 0

If rstPurchases.RecordCount > 0 Then
    rstPurchases.MoveFirst
    Do While Not rstPurchases.EOF
        iteration = iteration + 1
        counter = 0
        Do While counter < 11
            counter = counter + 1
            Dim p As String
            p = ("Purchase" & iteration & "-" & counter)
            Dim Purchase As clsPurchaseItem
            Set Purchase = New clsPurchaseItem
            bCode = "budgetCode" & counter
            transDate = "transDate" & counter
            ven = "vendor" & counter
            amt = "amount" & counter
            req = "requestedBy" & counter
            desc = "description" & counter
            If Not rstPurchases.Fields(bCode).value = "" Then
                MsgBox p
                Purchase.CardHolderID = rstPurchases.Fields("cardEmpId").value
                MsgBox "Card Holder ID: " & Purchase.CardHolderID

                Purchase.CardHolderName = rstPurchases.Fields("cardName").value
                MsgBox "Card Holder Name: " & Purchase.CardHolderName

                Purchase.StatementDate = rstPurchases.Fields("currDate").value
                MsgBox "Statement Date: " & Purchase.StatementDate

                Purchase.Department = rstPurchases.Fields("deptname").value
                MsgBox "Department: " & Purchase.Department

                Purchase.BudgetCode = rstPurchases.Fields(bCode).value
                MsgBox "Budget Code: " & Purchase.BudgetCode

                Purchase.TransactionDate = rstPurchases.Fields(transDate).value
                MsgBox "Transaction Date: " & Purchase.TransactionDate

                Purchase.Vendor = rstPurchases.Fields(ven).value
                MsgBox "Vendor:" & Purchase.Vendor

                Purchase.Amount = rstPurchases.Fields(amt).value
                MsgBox "Purchase Amount: " & Purchase.Amount

                Purchase.RequestedBy = rstPurchases.Fields(req).value
                MsgBox "Requested By: " & Purchase.RequestedBy

                Purchase.Description = rstPurchases.Fields(desc).value
                MsgBox "Description: " & Purchase.Description

                Purchases.Add Purchase, p
            End If
        Loop
        rstPurchases.MoveNext
        MsgBox "Move To Next Record"
    Loop
End If
 MsgBox Purchases.Item("Purchase2-1").Description
End Sub