CODEWITHSUNDEEP
vbafunctiondictionaryms-access
Rock Darkwater
Rock Darkwater

Reputation: 5

Why does my scripting dictionary function in access vba only return keys?

I have an Access 2016 function that checks a scripting dictionary's values against a database of historical values and returns a dictionary of key/item pairs that don't fall inside a calculated error range. However, the function is only returning the keys, and a call to the item results in a run-time error 3420 - Object invalid or no longer set.

I debug the dictionary at the end of the function, and it prints fine, but when the function returns, it bugs out.

Here's the simplified call to the function:

sub Verify(index as long, frm as form)
  dim badComps as object
  dim comp as variant

  Set badComps = Check_History(INDEX, custID, Station)

    For Each comp In badComps.Items
        Debug.Print "'" & comp & "'"
    Next
End Sub

And here's the function itself: (EDIT: The function works, so i simplified it. The debug statement at the end prints everything I need to return to the Verify Sub)

Function Check_History(INDEX As Long, ByVal frmCust As String, ByVal frmStat As String) As Scripting.dictionary
    Dim avgs As Object, mPercents As Object, dict As Object
    Dim rst As DAO.Recordset, rst2 As DAO.Recordset
    Dim db As DAO.Database
    Dim compName As Variant, badKeys As Variant
    Dim i As Long

    Set db = CurrentDb
    Set mPercents = CreateObject("Scripting.Dictionary")
    Set dict = CreateObject("Scripting.Dictionary")

    'pull history for the passed station
    Set rst = db.OpenRecordset("SELECT * FROM [tblCalculated_Values] WHERE [INDEX] = " & INDEX)
    rst.MoveLast


    'pull history for the passed station.
    Set rst2 = db.OpenRecordset("SELECT * FROM [Sample History] WHERE [INDEX] = '" & frmCust & frmStat & "'")
    If rst2.RecordCount = 0 Then GoTo nohist
    rst2.MoveLast
    rst2.MoveFirst

    'calculate the average historical value for each component
    For i = 0 To rst2.RecordCount - 1
        For Each compName In mults.keys
            If avgs.Exists(compName) Then
                avgs.Item(compName) = avgs.Item(compName) + rst2.fields(compName)
            Else
                avgs.Add compName, rst2.fields(compName)
            End If
        Next
        rst2.MoveNext
    Next
    rst2.MoveFirst

    For Each compName In mults.keys
        If avgs.Exists(compName) Then
            If IsNull(avgs.Item(compName)) Then avgs.Item(compName) = 0
            avgs.Item(compName) = avgs.Item(compName) / rst2.RecordCount
        End If
    Next

        'If sample falls outside the range of avg +- 1, add error to dictionary

        If mPercents.Item(compName) > 0 And avgs.Item(compName) > 0 Then
            If mPercents.Item(compName) < WorksheetFunction.Max(0.001, Round(avgs.Item(compName) - 1, 3)) Or _
                mPercents.Item(compName) > Round(avgs.Item(compName) + 1, 3) Then dict.Add compName, mPercents.Item(compName)
            If dict.Exists(compName) Then Debug.Print compName, dict.Item(compName)            
        End If
    Next

    badKeys = dict.keys
    'if no errors, add key = "clean" & item = 0, else return dictionary of component, avg value

    If UBound(badKeys) = -1 Then dict.Add "clean", 0

    Set Check_History = dict

nohist:
End Function

Any help/insight/tips would make my day a lot brighter. TIA!

Upvotes: 0

Views: 254

Answers (1)

Tim Williams
Tim Williams

Reputation: 166456

Ignoring the other issues with your posted code, this:

avgs.Add compName, rst2.fields(compName)

is a little ambiguous: do you mean to add the Field object itself, or the field's Value ?

It looks like you mean to do the latter, but you actually are doing the former. So when your dictionary is returned from the function, it may contain references to your (now closed) recordsets.

Your Debug.Print outputs are likely OK because the default Value property gets called for creating the Print outputs

avgs.Add compName, rst2.fields(compName).Value

should fix that.

Upvotes: 2

Related Questions