Object Invalid after a set command

dunagh

Registered User.
Local time
Today, 05:41
Joined
Apr 16, 2013
Messages
17
Hello all,

I have a bit of code that uses collections and transactions with a backend SQL server that I don't have access to. The database tracks installed software on computers. The software information comes from an external script and is saved as a delimited text file. It is then parsed and put into custom objects that are then put into collections. A computer can have anywhere from 200 to 500 entries to be uploaded if they are not already in the DB. To make this process faster I am attempting to use transactions as the increase in perfomence is almost 10 fold. However, the transaction is causing my code to break with a

"Run-time error '3420':
Object invalid or no longer set.

I have searched all over google and have yet to figure this one out. Any help or insight would be appricated.

The following is the code that causes troubles. I have cut the beginning of the code to keep it short, but all objects are properly Dim'd and set. This code works fine with the WrkSpace.BeginTrans and WrkSpace.CommitTrans commeted out.


Code:
    Dim db As Database
    Set db = DBEngine(0)(0)
 
    Dim rs As DAO.Recordset2
    Dim HyenaXPWSTable As DAO.Recordset2
    Dim WorkstationRST As DAO.Recordset2
 
    '<-Snip->
 
    Set HyenaXPWSTable = db.OpenRecordset("dbo_HYENA_XP_WRKSTN", dbOpenDynaset, dbSeeChanges)
    Set HyenaAppsRST = db.OpenRecordset("dbo_HYENA_APPLICATIONS", dbOpenDynaset, dbSeeChanges)
    '**************************************************************************
    ' Process each Workstation and add data to the db as needed.
    '**************************************************************************
    'On Error GoTo TransactionError
    For Each WorkstationElement In WorkstationsCollection
 
        WrkSpace.BeginTrans
 
        ' Is this row already in the appropriate Hyena_XPWorkstation or Hyena_Win7Workstation table?  If not, add it.
        FirstChar = Mid(WorkstationElement.Name, 1, 1)
        'Need to do:  -Get Computers actually in scope-
        If FirstChar = "7" Then
            InsTable = "dbo_Hyena_W7_Wrkstn"
        Else
            InsTable = "dbo_Hyena_XP_Wrkstn"
        End If
 
        For Each SoftwareElement In WorkstationElement.SoftwareCollection
            Debug.Print WorkstationElement.Name & " " & SoftwareElement.RegistryKeyName
            'Dim rs As DAO.Recordset2
            ' Is this app in the known list?  If not, add it.
            strSQL = "SELECT * FROM dbo_Hyena_Applications WHERE dbo_Hyena_Applications![HYENA_APPL_ID] = """ & SoftwareElement.UniqueKeyName & """"
            Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot, dbSeeChanges)
 
            '*******************************************************************
            rs.MoveLast '<- The Code stops here on the second WorkstationElement for the first SoftwareElement
            '*******************************************************************
 
            If rs.Recordcount < 1 Then
                AppMatchID = "NotMatch"
 
                ' If adding, does it have characteristics of things we filter automatically?  If so, filter on find and Build Sheet.  Start with false unless overruled.
                FilterOnXPFind = 0
 
                ' If Publisher is Microsoft
                If SoftwareElement.Publisher = "Microsoft Corporation" Then
 
                    'and first two characters of RegKeyName = KB or and DisplayName contains Security Update
                    RegKeyStart = Mid(SoftwareElement.RegistryKeyName, 1, 2)
                    If RegKeyStart = "KB" Or InStr(1, "Security Update", DisplayName, vbTextCompare) Then
                        FilterOnXPFind = 1
                    End If
                End If
 
                ' If DisplayName is Null or space filter.
                If IsNull(SoftwareElement.DisplayName) Or SoftwareElement.DisplayName = " " Then
                    FilterOnXPFind = 1
                End If
 
                ' If we haven't filtered it, does it match something that Applications knows about?
                If FilterOnXPFind < 1 Then
 
                    ' Look up in Applications and match display version and display name
                    rsalucount = 0
                    stralu = "SELECT ID FROM dbo_Applications WHERE App_Name = '" & SoftwareElement.DisplayName & "' AND App_Version = '" & SoftwareElement.DisplayVersion & "'"
                    Set rsalu = db.OpenRecordset(stralu, dbOpenDynaset, dbSeeChanges)
                    If rsalu.Recordcount > 0 Then
                        rsalu.MoveFirst
                        MatchID = rsalu!ID
                        AppMatchID = "Matched"
                    End If
                    'rsalu.Close
                End If
 
                ' Add it to Hyena_Applications.
                With HyenaAppsRST
                    .AddNew
                    HyenaAppsRST![HYENA_APPL_ID] = SoftwareElement.UniqueKeyName
                    HyenaAppsRST![REG_KEY_NM] = SoftwareElement.RegistryKeyName
                    HyenaAppsRST![APPL_VER_MJR] = SoftwareElement.VersionMajor
                    HyenaAppsRST![APPL_VER_MNR] = SoftwareElement.VersionMinor
                    HyenaAppsRST![PUBLSHR] = SoftwareElement.Publisher
                    HyenaAppsRST![dsply_nm] = SoftwareElement.DisplayName
                    HyenaAppsRST![dsply_ver] = SoftwareElement.DisplayVersion
                    HyenaAppsRST![FLTR_ON_XP_FIND] = FilterOnXPFind
                    If Not IsNull(MatchID) And AppMatchID = "Matched" Then
                        HyenaAppsRST!APPL_ID = MatchID
                    End If
                    .Update
                    NewAppCount = NewAppCount + 1
                End With
            End If
            'rs.Close
 
 
 
 
            strWSQ = "SELECT * FROM " & InsTable & " WHERE HYENA_APPL_ID = '" & SoftwareElement.UniqueKeyName & "' AND WRKSTN_NM = '" & WorkstationElement.Name & "'"
            Set rsq2 = db.OpenRecordset(strWSQ, dbOpenDynaset, dbSeeChanges)
            If rsq2.Recordcount < 1 Then
                'Set HyenaXPWSTable = db.OpenRecordset("dbo_HYENA_XP_WRKSTN", dbOpenDynaset, dbSeeChanges)
                With HyenaXPWSTable
                    .AddNew
                    HyenaXPWSTable![HYENA_APPL_ID] = SoftwareElement.UniqueKeyName
                    HyenaXPWSTable![WRKSTN_NM] = WorkstationElement.Name
                    HyenaXPWSTable![DT_LAST_SCNND] = Date
                    HyenaXPWSTable![MGR_APPRV_NOT_REQR_FLG] = 0
                    HyenaXPWSTable![MGR_APPRV_RSPNS_CD] = Null
 
                    .Update
                End With
                'HyenaXPWSTable.Close
            ElseIf rsq2.Recordcount = 1 Then
                rsq2.Edit
                rsq2![DT_LAST_SCNND] = Date
                rsq2.Update
            End If
            'rsq2.Close
 
            numLines = numLines + 1
            SysCmd acSysCmdSetStatus, "Processed " & CStr(numLines) & " lines of Hyena data..."
            DoEvents
        Next SoftwareElement
 
        'Stop
        'Tell the dbo_WRKSTN table when the last Hyena Capture date was for a workstation
        Set WorkstationRST = db.OpenRecordset("SELECT * FROM dbo_WRKSTN WHERE WRKSTN_NM = """ & WorkstationElement.Name & """;", dbOpenDynaset, dbSeeChanges)
        If Not WorkstationRST.EOF Then
            If Nz(WorkstationRST![HYENA_DATA_CAPTR_DT], #1/1/1900#) <> Date Then
 
 
                WorkstationRST.Edit
                WorkstationRST![HYENA_DATA_CAPTR_DT] = Date
                WorkstationRST.Update
 
                'WrkSpace.CommitTrans
                'WrkSpace.BeginTrans
            End If
        End If
 
        'WorkstationRST.Close
        Stop
        WrkSpace.CommitTrans
 
        DoEvents
 
    Next WorkstationElement
 
First off, remember to close the recordset before the NEXT keyword. Second, change this:
Code:
Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot, dbSeeChanges)
to this
Code:
If rs Is Nothing Then
   Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot, dbSeeChanges)
Else
   rs.OpenRecordset strSQL, dbOpenSnapshot, dbSeeChanges
End If
 
I don't have any means to test any theories but you are executing rs.MoveLast without testing for eof. Movelast/first will fail if there are no records

See this link

http://msdn.microsoft.com/en-us/library/windows/desktop/ms677527(v=vs.85).aspx

And in particular:
A call to either MoveFirst or MoveLast when the Recordset is empty (both BOF and EOF are True) generates an error.

Since you seem to be testing for a zero recordcount I suggest change your coding to
...
Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot, dbSeeChanges)

'*******************************************************************
' rs.MoveLast '<- The Code stops here on the second WorkstationElement for the first SoftwareElement
'*******************************************************************

If rs.bof Then
......
 
Thank you for the replies.

I tried adding the following code:

Code:
If rs Is Nothing Then
   Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot, dbSeeChanges)
Else
   rs.OpenRecordset strSQL, dbOpenSnapshot, dbSeeChanges
End If

But on the

Code:
rs.OpenRecordset strSQL, dbOpenSnapshot, dbSeeChanges

I get the error "Wrong number of Arguments or invalid property assignment."

I did use the

Code:
[FONT=Calibri]If rs.bof Then[/FONT]

code.

The weird thing is that today, it doesn't seem to matter if I use If rs.RecordCount < 1 Then... or If rs.BOF Then... They both work.

And I was moving to the last record because I was getting these errors and was vainly attempting to force Access to get an accurate count.
 
Last edited:
Sorry, there was a comma missing. It should be:
Code:
If rs Is Nothing Then
   Set rs = db.OpenRecordset(strSQL, [B][COLOR=red],[/COLOR][/B] dbOpenSnapshot, dbSeeChanges)
Else
   rs.OpenRecordset strSQL, [B][COLOR=red],[/COLOR][/B] dbOpenSnapshot, dbSeeChanges
End If
 
Sorry, there was a comma missing. It should be:
Code:
If rs Is Nothing Then
   Set rs = db.OpenRecordset(strSQL, [B][COLOR=red],[/COLOR][/B] dbOpenSnapshot, dbSeeChanges)
Else
   rs.OpenRecordset strSQL, [B][COLOR=red],[/COLOR][/B] dbOpenSnapshot, dbSeeChanges
End If

Still getting the wrong number of agruments error with the added comma.

The MSDN documentation does not have information regarding that many number of parameters. So I am still a little confused about this.

Thanks,
 
Still getting the wrong number of agruments error with the added comma.

The MSDN documentation does not have information regarding that many number of parameters. So I am still a little confused about this.

Thanks,

I noticed you are using the Recordset2 object instead of Recordset. I'm not sure how that is used. I know it has to deal with multi-valued fields but the syntax I was giving was for the regular recordset object. I can't find any good info so far to show how to use the Recordset2 object. Since it has a ParentRecordset property, perhaps you are supposed to open the Recordet object first and then open the Recordset2 object by focusing on the multi-valued field.
 
A critique I have of that code block is that it's way too long. Break that down into smaller, more manageable, more debuggable subroutines. Make "FilterOnXPFind" a function. Make "AddNewHyenaApp" a Function. Make "AddNewHyenaXPWS" a Function. If you pool all that functionality in one big routine like you've done, then all your variables have way more scope than they need, and you've left a ton of nooks and crannies for bugs to hide, and you muddy up the overall structure of your solution with too much detail.

Subroutines enforce minimum scope for variables. Subroutines are self documenting. Subroutines localize errors. Subroutines clarify the process that calling code is executing. I guarantee that if you break that code down into subroutines you will find THE problem, and you'll find at least one problem you don't even know about yet, and you'll make your code way easier to understand and maintain going forward.
 
@boblarson, Thanks for the info. I will play around with the parent property. Being that Access seems to be working with the code as of now, I will move on as I have a ton of other requests to put into this "Application".

@lagbolt, Yes, breaking processes into smaller, self-contained subs is something I agree with. I inherited this project and this code from someone else who didn't put too much effort into comments or using obvious variable name meanings. In fact, the code that I posted was way longer and had a lot of redundancies. I have shortened it up but I can't really spend too much time on it as of all the other requirements I must write for this project. In my other life, coding in Java or C#, I am a big proponent of code reuse, making methods that only do one task, and add the relevant comments. Having experience with the Java and .Net libraries and now working in VBA, I have created a nice dent in my keyboard learning to work around the lack of features. :-)

I appreciate everyone's advice and patience with my foray into the VBA world.
 
I did use the

Code:
[FONT=Calibri]If rs.bof Then[/FONT]
code.

My coding style is to actually test two things to determine if it is an empty adoRS object:

Code:
  'Define attachment to database table specifics and execute commands via With block
  Set adoRStt = CreateObject("ADODB.Recordset")
  With adoRStt
    .ActiveConnection = CurrentProject.Connection
    .CursorType = adOpenDynamic
    .LockType = adLockOptimistic
    .Open strSQL

    'Was no record found?
    [COLOR=Blue][B]If .BOF Or .EOF Then[/B][/COLOR]
      PostRefreshLocalTmpTbl = False
      GoTo Exit_PostRefreshLocalTmpTbl
    Else
      'Try fetching this first record found
      If Me.Priv_PostRefreshLocalTmpTblFetch() Then
        PostRefreshLocalTmpTbl = True
      Else
        'rrrrr??? Thought we had data...
        PostRefreshLocalTmpTbl = False
        GoTo Exit_PostRefreshLocalTmpTbl
      End If
    End If

    'Continue until .EOF
    While .EOF = False
      'Move onto the next record
      Call Me.PostRefreshLocalTmpTblFetchNext
    Wend
  End With

  'Close the adoRS object
  adoRStt.Close

  'Clean up the connection to the database
  Set adoRStt = Nothing
 

Users who are viewing this thread

Back
Top Bottom