We help IT Professionals succeed at work.
Get Started

MaxLockPerFile

mlcktmguy
mlcktmguy asked
on
190 Views
Last Modified: 2015-06-20
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

Open in new window

Comment
Watch Question
Consultant (Development Team Lead, Senior Support Engineer, and Technical Test Leader)
CERTIFIED EXPERT
Commented:
This problem has been solved!
Unlock 2 Answers and 7 Comments.
See Answers
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE