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

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

Answer 1

问题是您使用Dim As New

Dim Purchase As New clsPurchaseItem似乎与Dim Purchase As clsPurchaseItem和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

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

1 个答案: