Database shifts to locked while vba coding and testing.

[cmgrn]

This week my access 2002 has started blocking me from the code, test, code, test that I use constantly.
I am using vba and dao 3.6 to code a function in a module. After coding, I run the function to sample results then return to coding BUT this week access stops me from returning to coding with the 'database has been placed in a state by user admin ... error 3734' message and I have to close the db and reopen to return to coding.
I am the only one using this db and placing it on our network or my pc has made no difference.
I have noticed that the problem does not seem to occur if I comment out my use of CurrentDB.
I have searched the internet, checked my options 'open as' setting (shared) and checked for stray .ldb files. I also have make a new db and copied objects from the old to the new db which did not help and completely started over and created a db from scratch which did not help.
My 3 tables are from a "List of Excluded Individuals/Entities" website related to Medicare/Medicaid and were imported into access from downloaded .dbf files using the dbase 5 option.

Here is my initial code that stopped working when I added the CurrentDB section...

Option Compare Database
Option Explicit
'
Global db As DAO.Database
Global dbAstor36Main As DAO.Database
'
Global rs As DAO.Recordset
Global rsEmp As DAO.Recordset
'
Global I As Long
Global strSQL As String
'
Public Const conAstor36Main As String = "\\NT-Finance\Astorware\Astor36Main.MDB"
Public Const conEmployees As String = "tblEmployees"
'
Global strFirstInitial() As String
Global strMiddleInitial() As String
Global strLastName() As String
Global varHireDate() As Variant
Global varTermDate() As Variant
Global RC As Long
'

Public Function Search_LEIE_Database()

    'Search the List of Excluded Individuals/Entities for matches against Astor's employees
    
    Set dbAstor36Main = OpenDatabase(conAstor36Main)
    strSQL = "SELECT * FROM [" & conEmployees & "] ORDER BY [LastName], [FirstName], [MiddleName];"
    Set rsEmp = dbAstor36Main.OpenRecordset(strSQL)
    With rsEmp
        .MoveLast
        .MoveFirst
        RC = CLng(.RecordCount)
        ReDim strFirstInitial(1 To RC)
        ReDim strMiddleInitial(1 To RC)
        ReDim strLastName(1 To RC)
        ReDim varHireDate(1 To RC)
        ReDim varTermDate(1 To RC)
        I = 0
        Do Until .EOF
            I = I + 1
            strFirstInitial(I) = Left(Trim(CStr("" & .Fields("FirstName"))), 1)
            strMiddleInitial(I) = Left(Trim(CStr("" & .Fields("MiddleName"))), 1)
            strLastName(I) = Trim(CStr("" & .Fields("LastName")))
            If IsDate(.Fields("LastHireDate")) Then
                varHireDate(I) = CDate(.Fields("LastHireDate"))
            Else
                varHireDate(I) = Null
            End If
            If IsDate(.Fields("TerminationDate")) Then
                varTermDate(I) = CDate(.Fields("TerminationDate"))
            Else
                varTermDate(I) = Null
            End If
            .MoveNext
        Loop
        .Close
    End With
    Set rsEmp = Nothing
    dbAstor36Main.Close
    Set dbAstor36Main = Nothing
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset("UPDATED_20090514") '45111
    'Set rs = CurrentDB.OpenRecordset("UPDATED_20090514") '45111

    With rs
        I = 0
        Do Until .EOF
            I = I + 1
            .MoveNext
        Loop
        .Close
    End With
    Set rs = Nothing
    db.Close
    Set db = Nothing
    
    MsgBox I

End Function

Thanks in advance for any help anyone provides.
Mike

 

[PHV]

I'd get rid of the following:
db.Close

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886