Access VBA Runtime Error 3052, file sharing lock count exceeded

Question

I am working on a table with 1.5 million records and i want to change the dates which are smaller than the current date to current date and fill the empty fields with current date.

I tried my codes on a small example, it works,but when i run on the actual table, it will have error "File sharing lock count exceeded"

As i am new to access vba, my codes are pretty basic n draggy, so i not sure if the problem is caused by that.

I wanted to use if or to shortern my codes, but when i use If (IsNull(rs.Fields(12))) Or (CDate(rs.Fields(12)) < currDateTime) Then

It will show me invalid use of null.

Sub fillcurrentdate()
Dim db As DAO.Database
Set db = CurrentDb
Dim rs As DAO.Recordset
Set rs = db.OpenRecordset("Final", dbOpenDynaset, dbSeeChanges)
Dim currDateTime As Date
currDateTime = Date
rs.MoveFirst
Do While Not rs.EOF

If IsNull(rs.Fields(4)) Then
rs.Edit
rs.Fields(4) = currDateTime
rs.Update

ElseIf CDate(rs.Fields(4)) < currDateTime Then
rs.Edit
rs.Fields(4) = currDateTime
rs.Update

End If

If IsNull(rs.Fields(11)) Then
rs.Edit
rs.Fields(11) = currDateTime
rs.Update

ElseIf CDate(rs.Fields(11)) < currDateTime Then
rs.Edit
rs.Fields(11) = currDateTime
rs.Update

End If


If IsNull(rs.Fields(12)) Then
rs.Edit
rs.Fields(12) = currDateTime
rs.Update

ElseIf CDate(rs.Fields(12)) < currDateTime Then
rs.Edit
rs.Fields(12) = currDateTime
rs.Update

End If

If IsNull(rs.Fields(13)) Then
rs.Edit
rs.Fields(13) = currDateTime
rs.Update

ElseIf CDate(rs.Fields(13)) < currDateTime Then
rs.Edit
rs.Fields(13) = currDateTime
rs.Update

End If

If IsNull(rs.Fields(15)) Then
rs.Edit
rs.Fields(15) = currDateTime
rs.Update

ElseIf CDate(rs.Fields(15)) < currDateTime Then
rs.Edit
rs.Fields(15) = currDateTime
rs.Update

End If


rs.MoveNext
Loop
End Sub

Will appreciate if anyone is able to advice me on this.

Search web for error message (copy/paste), that should help;) — ComputerVersteher
You don't want to do this by looping through the table. Instead you want to use SQL or Queries to do this. You can run either from code or Macros. Create > Query Design - Select your table > Update (query type). — user11509084

ComputerVersteher ComputerVersteher · Accepted Answer · 2019-07-25T10:06:32

Until you searched for the error message (I will provide a sql solution then), some improvements on your code.

Always keep your code DRY, as 'wet' code rottens.
If you users.MoveFirst, you have to check the recordset for not being empty, but there is no need forrs.MoveFirston a just opened recordset, it starts there automatic.
Don't use recordset fields index, unless you need this for performance, as it makes your code hard to read and if you delete a field from a query, the index of a later field changes. Use the fieldname instead.
If (IsNull(rs.Fields(12))) Or (CDate(rs.Fields(12)) < currDateTime)fails because you can't use CDate on Null values. You have to useNzorIIf, but you can skipIsNullcondition as if value is Null, it gets set to a value lower thancurrDateTime.

All updates in a loop (add the Fieldnames to the array in For Each loop)

...
Dim Fieldname as Variant
Do Until rs.EOF ' better readable than While Not as no double negation (True instead of Not False)
  rs.Edit
  For Each Fieldname in Array("FieldnameOfIndex4", ... , "FieldnameOfIndex15")
    If CDate(Nz(rs.Fields(Fieldname).Value,#00:00:00#)) < currDatetime Then ' or "IIf(IsNull(rs.Fields(Fieldname).Value), #00:00:00#, rs.Fields(Fieldname).Value)" as more general (Nz is Ms Access only)
      rs.Fields(Fieldname).Value = currDatetime
    End If
  Next Fieldname
  rs.Update
  rs.MoveNext
Loop
...

Access VBA Runtime Error 3052, file sharing lock count exceeded

1 Answers