VBA to change maximum number of locks allowed on a recordset

**NeoPa** · Mar 20 '10, 02:25 PM

There are a few issues to deal with here :

I could find no reference to MaxLocksPerFile in the Help system. I specifically looked in SetOption.
SetOption seems to be a facility provided to change the options found under the Tools menu. I found nothing in there either related to this.
If this value were to be changed using this interface, then I expect the change made would change the registry. It would simply be doing it via a different interface.
Last, but certainly not least, if you have some code that needs this to be extended then there is a very good chance that the code should be looked at. The resources used for each lock are not trivial. If you have code that processes through recordsets without tidying itself up properly, then this is code that you want to change or otherwise lose. I hesitate to say throw away and start again, but I would give careful consideration to maintaining minimum locks during any piece of the code.

I don't suppose this is what you wanted to hear, but I'm afraid I'd be doing you no service if I'd left it unsaid.

**ADezii** · Mar 20 '10, 02:43 PM

The good news is that the solution to your problem lies below, the bad news is that it only applies to the Current Session. Execute the following code 'prior' to executing your Function. Be sure to set the Reference to the DAO Object Library as indicated in the Comment. The Default Number of Locks Per File as defined by Jet is 9,500, the code will 'temporarily' increase this Value to 15000. This should be enough for your process to complete successfully. Let us know how you make out.

Code:

'Must first set a Reference to the Microsoft DAO X.X Object Library
DAO.DBEngine.SetOption dbMaxLocksPerFile, 15000

EXAMPLE

Code:

DAO.DBEngine.SetOption dbMaxLocksPerFile, 15000

Call UpdateToMaster

P.S. - The SetOption that you are referring to, and Referenced in the code, is the SetOption Method of the DBEngine Object NOT the Access Application Object.

**NeoPa** · Mar 20 '10, 02:45 PM

On the other hand, if that's your code, then I don't see too many multi-level updates, and the .Edit is always matched by the .Update. It seems that Jet must be doing some kind of transaction management. It (Help) tells me that it doesn't, yet I can see no alternative. Clearly if it's maintaining the lock info it must be maintaing locks even after the .Update has been run.

If that is the case, I would consider handling the error and doing a Close and Reopen of your recordsets before continuing. You could simply increase the value of MaxLocksPerFile, but there will potentially be situations where even an increased one overflows. Closing and reopening does introduce a certain overhead, but not too onerous in such simple cases (I would consider opening the recordsets as Tables mind-you). Your code would need to handle continuing from where it left off though. This is not 100% straightforward when the tables have been closed between records.

**NeoPa** · Mar 20 '10, 02:53 PM

Originally posted by ADezii

P.S. - The SetOption that you are referring to, and Referenced in the code, is the SetOption Method of the DBEngine Object NOT the Access Application Object.

Nice ADezii.

I suspect this is far more what the OP was after, and doesn't effect the registry (which is ideal for their purposes).

With that tip I was able to find the reference in Help for the method.

I'm curious to understand better why the code posted should have this problem though. It's actually pretty tidy as far as clearing down any resources goes. Perhaps one of the Access options specifies whether or not to treat such code as a massive transaction or not. Any ideas gratefully welcomed (BTW I see this as specifically relevant to this thread hence not reposting separately).

Your answer is clearly the best one for this thread's original question.

**ADezii** · Mar 20 '10, 08:55 PM

This is a strange one NeoPa. This Error usually occurs when 1 or more Users are involved in Multiple Transactions within a Multi-User Environment. To make things stranger, I worked on the Database in work without setting the MaxLocksPerFile to 15000, and it worked flawlessly with the Default Setting of 9500. Same Access Version, comparative CPUs and Memory, etc. The only 'major' difference is that I'm networked in work, while at home I work on a Stand-a-Lone PC. Any ideas?

**KPR1977** · Mar 20 '10, 08:57 PM

Thanks so much guys for responding and offering up insight into the dilemma I'm facing. ADezii, once again you knocked it out of the park! This line of code you offered was the key to overcoming the error message I was getting.

Code:

DAO.DBEngine.SetOption dbMaxLocksPerFile, 15000

I also see what you are saying about running it in a separate session. However, in order for it to work, I had to run it inside of my UpdateToMaster( ) function. On the downside, I'm unable to call anything else within the UpdateToMaster( ), but if I create a seperate module, kind of like you suggested, it will allow me to run as many functions or routines as I need. =)

eg.

Module1

Code:

Public Function RunCodeProcesses()
Call UpdateToMaster
Call WorkedMsgBox
End Function

Module2

Code:

Option Compare Database
Option Explicit

Public Function UpdateToMaster()
DAO.DBEngine.SetOption dbMaxLocksPerFile, 15000

Dim updaterec As Boolean
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset

Dim Ctr As Integer

Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT " & _
                          "PioCode, MdlYear, SRSER2, SRFMLY, SRDOOR, SRTRIM, SRTRAN, VMACCE, VMINT, VMEXT, Sunroof, ConvMirror, fldupdated " & _
                          "FROM rawPIOapplications", dbOpenDynaset)
Set rs2 = db.OpenRecordset("SELECT " & _
                           "fldPIO, fldMdlYr, fldSeries, fldFamily, fldDoor, fldTrim, fldTrans, fldAccGrp, fldIntColor, fldExtColor, fldSunroof, fldConvMirror " & _
                           "FROM tblPioMaster", dbOpenDynaset)

rs.MoveFirst
rs2.MoveFirst

With rs2

   Do Until .EOF
      Do Until rs.EOF

      If rs!fldupdated = 0 Then

         updaterec = True

            For Ctr = 0 To 11  'Update this when adding additional criteria (e.g. 0-11 = 12 fields from MasterTable)
               If Not IsNull(.Fields(Ctr)) Then
                  If .Fields(Ctr) <> rs.Fields(Ctr) Then
                     updaterec = False
                        Exit For
                  End If
               End If
            Next Ctr

         If updaterec = True Then
            rs.Edit
               rs!PioCode = IIf(IsNull(!fldPIO), Null, !fldPIO)
               rs!MdlYear = IIf(IsNull(!fldMdlYr), Null, !fldMdlYr)
               rs!SRSER2 = IIf(IsNull(!fldSeries), Null, !fldSeries)
               rs!SRFMLY = IIf(IsNull(!fldFamily), Null, !fldFamily)
               rs!SRDOOR = IIf(IsNull(!fldDoor), Null, !fldDoor)
               rs!SRTRIM = IIf(IsNull(!fldTrim), Null, !fldTrim)
               rs!SRTRAN = IIf(IsNull(!fldTrans), Null, !fldTrans)
               rs!VMACCE = IIf(IsNull(!fldAccGrp), Null, !fldAccGrp)
               rs!VMINT = IIf(IsNull(!fldIntColor), Null, !fldIntColor)
               rs!VMEXT = IIf(IsNull(!fldExtColor), Null, !fldExtColor)
               rs!Sunroof = IIf(IsNull(!fldSunroof), Null, !fldSunroof)
               rs!ConvMirror = IIf(IsNull(!fldConvMirror), Null, !fldConvMirror)
               
               rs!fldupdated = -1
            rs.Update
         End If

      End If
         rs.MoveNext

      Loop
           .MoveNext
         rs.MoveFirst
   Loop

End With

rs.Close
rs2.Close

Set db = Nothing
Set rs = Nothing
Set rs2 = Nothing


End Function

Module3

Code:

Public Sub WorkedMsgBox()
MsgBox "Worked!  Thanks ADezii!!!!", vbExclamation, "Yay!!!"
End Sub

ADezii, I read your profile and I see that you were a Fire Fighter. Are you sure you didn't work for NASA, too??? Anyhow, I thank you for your service and I thank you for your solution. ;-)

**ADezii** · Mar 20 '10, 09:48 PM

I think that I can also speak for NeoPa in that we were more than happy to assist you in this matter. Stop by again, should the need arise!

**NeoPa** · Mar 20 '10, 10:23 PM

Originally posted by ADezii

Any ideas?

'Fraid not my friend. I'm a bit green when it comes to multi-user environments to be fair. I can sometimes think into it and come up with solutions, but it's not something I get into very often.

PS. Of course you speak for me. I was happy to provide what little insight I could on this subject.