By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,678 Members | 2,377 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,678 IT Pros & Developers. It's quick & easy.

VBA to change maximum number of locks allowed on a recordset

P: 23
Hi all. The code I run below runs perfectly in cases where I have a small amount of records. However, in cases were I have several thousands of records, the code only partially runs before giving me the error message of:
Expand|Select|Wrap|Line Numbers
  1. "File sharing lock exceeded. Increase MaxLocksPerFile registry entry."
Expand|Select|Wrap|Line Numbers
  1. "You have exceed the maximum number of locks allowed on a recordset. This limit is specified by the MaxLocksPerFile setting in your system registry.  The default value is 9500, and can be changed either by editing the registry or with the SetOption method."
For my case, the "SetOption method" sound like the way I want to go since I do not want to mess with my system registry. Does anyone know how to impliment this in my code below? Or maybe there's some simple refinements that need to be made to the code itself. I'm guess ADezii will probably land a solution. =)

As always, I so appreciate any suggestions. I attached a database with two modules that allow you to see the code working on a small set of records (modGo) and then failing on a large set of records (modNoGo).
Expand|Select|Wrap|Line Numbers
  1. Option Compare Database
  2. Option Explicit
  3.  
  4. Public Function UpdateToMaster()
  5.  
  6. Dim updaterec As Boolean
  7. Dim db As DAO.Database
  8. Dim rs As DAO.Recordset
  9. Dim rs2 As DAO.Recordset
  10.  
  11. Dim Ctr As Integer
  12.  
  13. Set db = CurrentDb
  14. Set rs = db.OpenRecordset("SELECT " & _
  15.                           "PioCode, MdlYear, SRSER2, SRFMLY, SRDr, SRTRIM, SRTRAN, VMACCE, VMINT, VMEXT, SR, CM, fldupdated " & _
  16.                           "FROM tblNoGo", dbOpenDynaset)
  17. Set rs2 = db.OpenRecordset("SELECT " & _
  18.                            "fldPIO, fldMdlYr, fldSeries, fldFamily, fldDr, fldTrim, fldTrans, fldAccGrp, fldIntClr, fldExtClr, fldSR, fldCM " & _
  19.                            "FROM tblPioMaster", dbOpenDynaset)
  20.  
  21. rs.MoveFirst
  22. rs2.MoveFirst
  23.  
  24. With rs2
  25.  
  26.    Do Until .EOF
  27.       Do Until rs.EOF
  28.  
  29.       If rs!fldupdated = 0 Then
  30.  
  31.          updaterec = True
  32.  
  33.             For Ctr = 0 To 11  'Update this when adding additional criteria (e.g. 0-11 = 12 fields from MasterTable)
  34.                If Not IsNull(.Fields(Ctr)) Then
  35.                   If .Fields(Ctr) <> rs.Fields(Ctr) Then
  36.                      updaterec = False
  37.                         Exit For
  38.                   End If
  39.                End If
  40.             Next Ctr
  41.  
  42.          If updaterec = True Then
  43.             rs.Edit
  44.                rs!PioCode = IIf(IsNull(!fldPIO), Null, !fldPIO)
  45.                rs!MdlYear = IIf(IsNull(!fldMdlYr), Null, !fldMdlYr)
  46.                rs!SRSER2 = IIf(IsNull(!fldSeries), Null, !fldSeries)
  47.                rs!SRFMLY = IIf(IsNull(!fldFamily), Null, !fldFamily)
  48.                rs!SRDr = IIf(IsNull(!fldDr), Null, !fldDr)
  49.                rs!SRTRIM = IIf(IsNull(!fldTrim), Null, !fldTrim)
  50.                rs!SRTRAN = IIf(IsNull(!fldTrans), Null, !fldTrans)
  51.                rs!VMACCE = IIf(IsNull(!fldAccGrp), Null, !fldAccGrp)
  52.                rs!VMINT = IIf(IsNull(!fldIntClr), Null, !fldIntClr)
  53.                rs!VMEXT = IIf(IsNull(!fldExtClr), Null, !fldExtClr)
  54.                rs!SR = IIf(IsNull(!fldSR), Null, !fldSR)
  55.                rs!CM = IIf(IsNull(!fldCM), Null, !fldCM)
  56.  
  57.                rs!fldupdated = -1
  58.             rs.Update
  59.          End If
  60.  
  61.       End If
  62.          rs.MoveNext
  63.  
  64.       Loop
  65.            .MoveNext
  66.          rs.MoveFirst
  67.    Loop
  68.  
  69. End With
  70.  
  71. rs.Close
  72. rs2.Close
  73.  
  74. Set db = Nothing
  75. Set rs = Nothing
  76. Set rs2 = Nothing
  77. MsgBox "Worked!"
  78.  
  79. End Function
Attached Files
File Type: zip TestDb.zip (402.5 KB, 221 views)
Mar 20 '10 #1

✓ answered by ADezii

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.
Expand|Select|Wrap|Line Numbers
  1. 'Must first set a Reference to the Microsoft DAO X.X Object Library
  2. DAO.DBEngine.SetOption dbMaxLocksPerFile, 15000
EXAMPLE
Expand|Select|Wrap|Line Numbers
  1. DAO.DBEngine.SetOption dbMaxLocksPerFile, 15000
  2.  
  3. 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.

Share this Question
Share on Google+
8 Replies


NeoPa
Expert Mod 15k+
P: 31,276
There are a few issues to deal with here :
  1. I could find no reference to MaxLocksPerFile in the Help system. I specifically looked in SetOption.
  2. 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.
  3. 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.
  4. 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.
Mar 20 '10 #2

ADezii
Expert 5K+
P: 8,607
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.
Expand|Select|Wrap|Line Numbers
  1. 'Must first set a Reference to the Microsoft DAO X.X Object Library
  2. DAO.DBEngine.SetOption dbMaxLocksPerFile, 15000
EXAMPLE
Expand|Select|Wrap|Line Numbers
  1. DAO.DBEngine.SetOption dbMaxLocksPerFile, 15000
  2.  
  3. 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.
Mar 20 '10 #3

NeoPa
Expert Mod 15k+
P: 31,276
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.
Mar 20 '10 #4

NeoPa
Expert Mod 15k+
P: 31,276
@ADezii
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.
Mar 20 '10 #5

ADezii
Expert 5K+
P: 8,607
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?
Mar 20 '10 #6

P: 23
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.
Expand|Select|Wrap|Line Numbers
  1. 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
Expand|Select|Wrap|Line Numbers
  1. Public Function RunCodeProcesses()
  2. Call UpdateToMaster
  3. Call WorkedMsgBox
  4. End Function
  5.  

Module2
Expand|Select|Wrap|Line Numbers
  1. Option Compare Database
  2. Option Explicit
  3.  
  4. Public Function UpdateToMaster()
  5. DAO.DBEngine.SetOption dbMaxLocksPerFile, 15000
  6.  
  7. Dim updaterec As Boolean
  8. Dim db As DAO.Database
  9. Dim rs As DAO.Recordset
  10. Dim rs2 As DAO.Recordset
  11.  
  12. Dim Ctr As Integer
  13.  
  14. Set db = CurrentDb
  15. Set rs = db.OpenRecordset("SELECT " & _
  16.                           "PioCode, MdlYear, SRSER2, SRFMLY, SRDOOR, SRTRIM, SRTRAN, VMACCE, VMINT, VMEXT, Sunroof, ConvMirror, fldupdated " & _
  17.                           "FROM rawPIOapplications", dbOpenDynaset)
  18. Set rs2 = db.OpenRecordset("SELECT " & _
  19.                            "fldPIO, fldMdlYr, fldSeries, fldFamily, fldDoor, fldTrim, fldTrans, fldAccGrp, fldIntColor, fldExtColor, fldSunroof, fldConvMirror " & _
  20.                            "FROM tblPioMaster", dbOpenDynaset)
  21.  
  22. rs.MoveFirst
  23. rs2.MoveFirst
  24.  
  25. With rs2
  26.  
  27.    Do Until .EOF
  28.       Do Until rs.EOF
  29.  
  30.       If rs!fldupdated = 0 Then
  31.  
  32.          updaterec = True
  33.  
  34.             For Ctr = 0 To 11  'Update this when adding additional criteria (e.g. 0-11 = 12 fields from MasterTable)
  35.                If Not IsNull(.Fields(Ctr)) Then
  36.                   If .Fields(Ctr) <> rs.Fields(Ctr) Then
  37.                      updaterec = False
  38.                         Exit For
  39.                   End If
  40.                End If
  41.             Next Ctr
  42.  
  43.          If updaterec = True Then
  44.             rs.Edit
  45.                rs!PioCode = IIf(IsNull(!fldPIO), Null, !fldPIO)
  46.                rs!MdlYear = IIf(IsNull(!fldMdlYr), Null, !fldMdlYr)
  47.                rs!SRSER2 = IIf(IsNull(!fldSeries), Null, !fldSeries)
  48.                rs!SRFMLY = IIf(IsNull(!fldFamily), Null, !fldFamily)
  49.                rs!SRDOOR = IIf(IsNull(!fldDoor), Null, !fldDoor)
  50.                rs!SRTRIM = IIf(IsNull(!fldTrim), Null, !fldTrim)
  51.                rs!SRTRAN = IIf(IsNull(!fldTrans), Null, !fldTrans)
  52.                rs!VMACCE = IIf(IsNull(!fldAccGrp), Null, !fldAccGrp)
  53.                rs!VMINT = IIf(IsNull(!fldIntColor), Null, !fldIntColor)
  54.                rs!VMEXT = IIf(IsNull(!fldExtColor), Null, !fldExtColor)
  55.                rs!Sunroof = IIf(IsNull(!fldSunroof), Null, !fldSunroof)
  56.                rs!ConvMirror = IIf(IsNull(!fldConvMirror), Null, !fldConvMirror)
  57.  
  58.                rs!fldupdated = -1
  59.             rs.Update
  60.          End If
  61.  
  62.       End If
  63.          rs.MoveNext
  64.  
  65.       Loop
  66.            .MoveNext
  67.          rs.MoveFirst
  68.    Loop
  69.  
  70. End With
  71.  
  72. rs.Close
  73. rs2.Close
  74.  
  75. Set db = Nothing
  76. Set rs = Nothing
  77. Set rs2 = Nothing
  78.  
  79.  
  80. End Function
Module3
Expand|Select|Wrap|Line Numbers
  1. Public Sub WorkedMsgBox()
  2. MsgBox "Worked!  Thanks ADezii!!!!", vbExclamation, "Yay!!!"
  3. 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. ;-)
Mar 20 '10 #7

ADezii
Expert 5K+
P: 8,607
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!
Mar 20 '10 #8

NeoPa
Expert Mod 15k+
P: 31,276
@ADezii
'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.
Mar 20 '10 #9

Post your reply

Sign in to post your reply or Sign up for a free account.