MaxLockPerFile

I have a looping routine that passes thru a file of about 300,000 records.  The routine itself is very simple but I am encountering  error -2147217887 (maxlocksperfile exceeded) when I process about 35,000 records.
I can get all the records to process by selecting 'Debug' when the error pops up then hitting the continue arrow.  The message comes up every 20,000 records but I eventually get thru them all.

I added the statement
DAO.DBEngine.SetOption dbMaxLocksPerFile, 300000 at the top of the procedure but it doesn't seem to have any effect.

Is there something else I can do to keep the error from occurring.  I've never used Begin and End Transaction but perhaps that would help in this case.  Even though I can get this to process all records by doing the 'Debug' & Continue that only works for me.  I can't turn it over to the users that way.

Here's the procedure:

Public Sub distributeCOPOther()
'
DAO.DBEngine.SetOption dbMaxLocksPerFile, 300000
'
selectString = " Select *  from aaSynch_Step1_Converted Where [Other] <> 0"
'
Dim wkPeriod As Long
Dim wkPeriodMMDD As Long
Dim wkYear As Long
Dim wkPrincipal As Double
Dim wkPenalty As Double
Dim wkInterest As Double
Dim wkOther As Double
Dim wkLien As Double
Dim wkAttyFees As Double
Dim wkYearlyLienCost As Double
'
Dim wkYearThreshold As Double
'
startTime = Now
currTime = Now
'
dispCnt = 5000
dispMax = 300
'
Dim rsIn2 As ADODB.Recordset
Set rsIn2 = New ADODB.Recordset
rsIn2.Open selectString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
If rsIn2.EOF Then
    '
Else
    If rsIn2.RecordCount > 0 Then
        '
        rsIn2.MoveLast
        rsIn2.MoveFirst
        '
        totRecs = rsIn2.RecordCount
        recsRead = 0
        '
        dispCnt = 5000
        dispMax = 500
        '
        While Not rsIn2.EOF
            '
            recsRead = recsRead + 1
            '
      '      If recsRead > 250 Then
      '          Stop
      '      End If
            '
            dispCnt = dispCnt + 1
            If dispCnt > dispMax Then
                dispCnt = 0
                currTime = Now
                dispMsg = "Distributing COP Other Amount, Processing " & Format(recsRead, "Standard") & " Of " & Format(totRecs, "Standard") & RunTime(startTime, currTime)
                wkStatusRtn = SysCmd(acSysCmdSetStatus, dispMsg)
                DoEvents
            End If
            '
            wkPrincipal = Nz(rsIn2!Principal, 0)
            wkPeriod = Nz(rsIn2!Period, 0)
            wkOther = Nz(rsIn2!Other, 0)
            wkPeriodMMDD = Val(Mid(Trim(Str(Nz(rsIn2!Period, 0))), 5, 4))
            wkYear = Val(Mid(Trim(Str(Nz(rsIn2!Period, 0))), 1, 4))
            wkLien = 0
            wkAttyFees = 0
            '
            ' don't do fee records
            '
            If wkPeriodMMDD = 1231 Then
                If wkYear < 2014 Then
                    wkYearlyLienCost = 20
                    wkYearThreshold = 23.6     ' joe's number which is max lien plus atty fees on the lien amount
                Else
                    wkYearlyLienCost = 86.7
                    wkYearThreshold = 102.3
                End If
                '
                ' Per Joe, if Other less than zero put it all in Principal
                '
                If wkOther < 0 Then
                    wkPrincipal = Round(wkPrincipal + wkOther, 2)
                    wkLien = 0
                    wkAttyFees = 0
                Else
                    '
                    If wkOther >= wkYearThreshold Then
                        wkLien = wkYearlyLienCost
                        wkAttyFees = Round(wkOther - wkYearlyLienCost, 2)
                    Else
                        wkLien = Round(wkOther * (1 / 1.18), 2)
                        wkAttyFees = Round(wkOther - wkLien, 2)
                    End If
                End If
                '
                rsIn2!Principal = wkPrincipal
                rsIn2!Lien = wkLien
                rsIn2!AttyFees = wkAttyFees
                '
                rsIn2.Update
                '
            End If
            '
            rsIn2.MoveNext
        Wend
            
    End If
End If
'
rsIn2.Close
Set rsIn2 = Nothing

End Sub

Select all Open in new window