Occasionally Locked Out of Access Database

[Mark]

Running VB coded from Excel to update information from an Access
database.
When the code is run from Excel it works most times. But occasionally
I get error 4866 saying the Access database is opened exclusively by
admin.

Here is the VB code (it locks up on the line with asterisks
****************************:

Private Sub CommandButton1_Click()
ActiveWorkbook.RefreshAll
Worksheets("FLOOR").Range("A1:HH50000").Clear
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim xlApp As Object
Dim xlWb As Object
Dim xlWs As Object
Dim recArray As Variant
Dim strDB As String
Dim fldCount As Integer
Dim recCount As Long
Dim iCol As Integer
Dim iRow As Integer
strDB = Worksheets("input").Range("C4")
Set xlApp = Application
Set ap = CreateObject("Access.Application")
ap.OpenCurrentDatabase (strDB)
cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDB & ";"
xlApp.Sheets("FLOOR").Select
rst.Open "Select * From [LOTS]", cnt ****************************
Set xlWb = ActiveWorkbook
Set xlWs = xlWb.Worksheets("FLOOR")
fldCount = rst.Fields.Count
For iCol = 1 To fldCount
xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
Next
xlWs.Cells(2, 1).CopyFromRecordset rst
rst.Close
cnt.Close
xlApp.Sheets("MIN BID BUYERS").Select
Set ap = Nothing
Set rst = Nothing
Set cnt = Nothing
Set xlWs = Nothing
Set xlWb = Nothing
Set xlApp = Nothing
End Sub

Thanks in advance for your suggestions. Could there be something that
is left open in the closing statements of the subroutine above? Maybe
it works a few times and then is opened too many times - is there some
limit that is being exceeded possibly? Grasping for an explanation
here...