MS Access VBA: Adding multiple Objects to a collection

Question

I am attempting to add multiple objects to a collection.

I have a few loops building and populating my object then adding the object to the collection.

The problem is that when I watch the collection it shows all the objects being the same instead of each having the data from the record that built them.

How can I correct this? Do I need to deconstruct my object before rebuilding the next object?



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

Perhaps adding Set Purchase = New clsPurchaseItem after Dim will solve that — Victor K
– Victor K, Commented Jun 19, 2018 at 19:35
It is my understanding that an object can be initiated two different ways. Dim Purchase As New clsPurchaseItem - Declares and Initializes the Object OR Dim Purchase As clsPurchaseItem - Declares the Object Set Purchase = New clsPurchaseItem - Initializes the Object — John Ring
– John Ring, Commented Jun 19, 2018 at 19:57
Dim statements are not executable. Dim ... As New should be nuked from orbit. Try Dim a As New Collection then do a.Add 42 then do Set a = Nothing, and then Debug.Print a.Count - at this point you should be expecting run-time error 91 for making a member call on a null object reference. But that's not what's happening. Heck replace Debug.Print a.Count with Debug.Print a Is Nothing - merely referring to a will respawn the object. Dim ... As New is poison. — Mathieu Guindon
– Mathieu Guindon, Commented Jun 19, 2018 at 20:49

Erik A · Accepted Answer · 2018-06-19 19:57:59Z

The problem is your use of Dim As New

Dim Purchase As New clsPurchaseItem may seem identical to Dim Purchase As clsPurchaseItem and Set Purchase = clsPurchaseItem, but it isn't. It only initializes Purchase once, and leaves it in a weird, indestructible state.

As Victor K said, you need to set it manually. But you also need to get rid of 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

This was the problem. I was not reinitializing the object for each iteration of the loop. Thanks to both you and @Victor K

Collectives™ on Stack Overflow

MS Access VBA: Adding multiple Objects to a collection

1 Answer 1

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related