访问VBA运行时错误3052，超出了文件共享锁定计数 [英] Access VBA Runtime Error 3052, file sharing lock count exceeded

问题描述

我正在处理具有150万条记录的表，我想将小于当前日期的日期更改为当前日期，并用当前日期填充空白字段.

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"

由于我是刚接触vba的新手，所以我的代码非常基础，所以我不确定问题是否是由那引起的.

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.

我想使用if或缩短我的代码，但是当我使用 如果(IsNull(rs.Fields(12)))或(CDate(rs.Fields(12))< currDateTime)然后

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

它将显示无效使用null的情况.

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.

推荐答案

在您搜索错误消息之前(然后我将提供一个sql解决方案)，对您的代码进行了一些改进.

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

1. 始终将您的代码 DRY 保留为湿"代码.
>
2. 如果使用rs.MoveFirst，则必须检查记录集是否为空，但是不需要在刚打开的记录集上使用rs.MoveFirst，它会自动从那里开始.
3. 请勿使用记录集字段索引，除非您需要此记录集以提高性能，否则它将使您的代码难以阅读，并且如果您从查询中删除某个字段，则后一个字段的索引也会更改.请改用字段名.
4. If (IsNull(rs.Fields(12))) Or (CDate(rs.Fields(12)) < currDateTime)失败，因为您不能对Null值使用CDate.您必须使用Nz或IIf，但是您可以跳过IsNull条件，就好像值是Null，它将被设置为小于currDateTime的值.

1. Always keep your code DRY, as 'wet' code rottens.
2. 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.
3. 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.
4. 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.

循环中的所有更新(将字段名添加到For Each循环中的数组中)

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
...

这篇关于访问VBA运行时错误3052，超出了文件共享锁定计数的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！