File Sharing Lock Count Exceeded

I have logic that passes thru a local table with 300K records.  What the routine does is simple but it keeps stopping with the 'File sharing locks exceeded' when I get to around record 10,000.

I did some research about this issue on EE and added the statement


DAO.DBEngine.SetOption dbMaxLocksPerFile, 200000

At the top of the processing.  There was no change, the error still occurred around record 10,000.

I also saw that registry revision is another way of handling this issue but that wouldn't work because I would have to do it on every user machine.  There are close to 40 users.

When I first wrote the routine it processed all 300k records with no issues, this problem came later.

Since this is a local table there is no need for any locks on the table.  No one but the current user will access it.

I pretty much use the same open statement on all of my ADO files.  Is there something that I can do to make the open more suitable for this process.  I don't know the effect of the options.  Here is the open I use.

rsIn.Open selectString, CurrentProject.Connection, adOpenKeyset, adLockPessimistic

Select allOpen in new window

I tried both optimistic and pessimistic locking with no change.

Here is the processing loop:

Dim CurrBRT As Long
Dim PrevBRT As Long
PrevBRT = 99999999

Dim BlockNum As Long
BlockNum = 0
'
Dim totRecs As Long
Dim recsRead As Long
Dim displayCount As Long
Dim displayMax As Long
Dim dispMsg As String

DAO.DBEngine.SetOption dbMaxLocksPerFile, 200000  ' or higher if necessary   'Microsoft DAO 3.6 Object Library

'wkDateStamp = Date
'wkDateTimeStamp = Now
'
selectString = "Select * from aSynch_Import_Raw " & _
               " Order By [ID] "
'
Dim rsIn As ADODB.Recordset
Set rsIn = New ADODB.Recordset
rsIn.Open selectString, CurrentProject.Connection, adOpenKeyset, adLockPessimistic    'adLockPessimistic    'adLockOptimistic
'
'Debug.Print selectString
'
If rsIn.EOF Then
    MsgBox "No Payment Records to Process.  Requested operation is terminated."
    Exit Sub
Else
    If rsIn.RecordCount > 0 Then
        '
        rsIn.MoveLast
        rsIn.MoveFirst
        '
        totRecs = rsIn.RecordCount
        displayMax = 50
        '
        While Not rsIn.EOF
            '
            recsRead = recsRead + 1
            displayCount = displayCount + 1
            If displayCount < displayMax Then
            Else
                dispMsg = "Processing Rec " & Trim(Str(recsRead)) & " Of " & Trim(Str(totRecs))
                wkStatusRtn = SysCmd(acSysCmdSetStatus, dispMsg)
                displayCount = 0
                DoEvents
            End If
            DoEvents
            '
            CurrBRT = Nz(rsIn!BRT, 0)
            '
            If CurrBRT = PrevBRT Then
            Else
                BlockNum = BlockNum + 1
                PrevBRT = CurrBRT
            End If
            '
            rsIn!BlockID = BlockNum
            '
'            If Mid(Nz(rsIn!Period, 0), 5) = "1231" Then
                rsIn!PrincipalNum = convertImportDbl2DecStrToNumber(Nz(rsIn!PrincipalStr, 0))
                rsIn!InterestNum = convertImportDbl2DecStrToNumber(Nz(rsIn!InterestStr, 0))
                rsIn!PenaltyNum = convertImportDbl2DecStrToNumber(Nz(rsIn!PenaltyStr, 0))
                rsIn!OtherNum = convertImportDbl2DecStrToNumber(Nz(rsIn!OtherStr, 0))
                rsIn!AttyFeesNum = convertImportDbl2DecStrToNumber(Nz(rsIn!AttyFeesStr, 0))
                rsIn!LienNum = convertImportDbl2DecStrToNumber(Nz(rsIn!LienStr, 0))
                rsIn!EligExpNum = 0
 '           Else
 '               rsIn!EligExpNum = convertImportDbl2DecStrToNumber(Nz(rsIn!OtherStr, 0))
 '           End If
            '
 '           rsIn!SynchYear = Val(Mid(Nz(rsIn!Period, 0), 1, 4))
            '
            rsIn.Update
            '
            ' write payments deactivated event record
            '
            rsIn.MoveNext
        Wend
            
    End If
End If
'
rsIn.Close
Set rsIn = Nothing
Stop

Select allOpen in new window

Any ideas?