Run-time Error '-2147467259 (80004005)'

[Townsend Clarkson II]

I'm having a security problem with MS Access and do not
know where to start looking. I'm writting some procedures
in the backend of a db. I'm reconnecting to that same
backend using ADO to perform some operations on a table. I
keep getting a connection problem that is not consistant.
It only seems to happen when ever I make a change to the
code and do not save the change.

The error is Run-time Error '-2147467259 (80004005)' The
database has been place in a state by the user "<user
name>" on machine "<machine name>" that prevents it form
bing opened or locked.

My colleague and I think the problem lies in the fact that
the db is opened and then we try to reconnect to the same
db to perform queries on a table.

Has anyone seen a similar problem or have any other
suggestions as to what the problem might be. I'm out of
ideas for the moment.

I'm opening and closing the connection in the same
function. I open the connection then the recordset, update
the table, and then close the recordset and close the
connection.

I can run the function and it will work fine. But when I
go into the code and for instance, uncomment a line for
testing without saving the change I get that error. Then
when the code breaks for the error if I save the db/code
it will run, but if I do not save the db/code it will not
run.

Here is the function:

Public Function addRecord(ByRef arr2D() As String, ByVal
strDBPath _
As String, ByVal strTblName As String) As Integer
'Variable declaration
Dim intj As Integer
Dim strDBN As String
Dim strTBN As String
Dim rs As ADODB.Recordset
Dim conn As ADODB.Connection
Dim strAccessConnect As String
Dim strArrayOfRecords() As String

'Intializing variables
intj = 0
strDBN = strDBPath
strTBN = strTblName
strArrayOfRecords() = arr2D()

'On Error GoTo ErrorHandler
'Opening connection to database
Set conn = New ADODB.Connection
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDBN & ";" & _
"Jet OLEDB:System
Database=J:\Mdw\ESIC17.mdw", "Admin", "12345"

'Opening database table
Set rs = New ADODB.Recordset
rs.Open strTblName, conn, adOpenDynamic, adLockOptimistic,
adCmdTable

DoCmd.SetWarnings False

'Adds records
If rs.RecordCount > 0 Then
rs.MoveLast
End If

For intj = 0 To (UBound(strArrayOfRecords, 2) - 1)
With rs
..AddNew
..Fields("Part Number") = strArrayOfRecords(0, intj)
..Fields("Cage") = strArrayOfRecords(1, intj)
..Fields("MTDP") = strArrayOfRecords(2, intj)
..Fields("Project") = strArrayOfRecords(3, intj)
..Fields("Owner") = strArrayOfRecords(4, intj)
..Fields("Desc") = strArrayOfRecords(5, intj)
..Fields("LAR") = strArrayOfRecords(6, intj)
..Update
..MoveNext
'Debug.Print strArrayOfRecords(0, intj), strArrayOfRecords
(1, intj), _
' strArrayOfRecords(2, intj), strArrayOfRecords(3, intj), _
' strArrayOfRecords(4, intj), strArrayOfRecords(5, intj),
strArrayOfRecords(6, intj)
End With
Next

DoCmd.SetWarnings True

rs.Close
Set rs = Nothing
conn.Close
Set conn = Nothing
addRecord = 0
Exit Function

ErrorHandler: 'in the event of an error adding records
branch here
DoCmd.SetWarnings True
'rs.Save (strDBPath)
Call errorMessage(2)
addRecord = 2
Resume

End Function

Thanks,

Townsend