访问 VBA 运行时错误 3052，超出文件共享锁定计数

Question

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

我在一个小例子上尝试了我的代码，它可以工作，但是当我在实际表上运行时，它会出现错误“超出文件共享锁定计数”

由于我是访问 vba 的新手，所以我的代码非常基本 n 拖沓，所以我不确定问题是否是由此引起的。

我想使用 if 或缩短我的代码，但是当我使用 If (IsNull(rs.Fields(12))) 或 (CDate(rs.Fields(12))

它会显示 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

如果有人能就此提出建议，我将不胜感激。

Answer 1

在你搜索到错误信息之前（我会提供一个sql解决方案），对你的代码进行一些改进。

1. 始终保留您的代码 DRY，因为“湿”代码会腐烂。
2. 如果您使用rs.MoveFirst，您必须检查记录集是否为空，但在刚刚打开的记录集上不需要rs.MoveFirst，它会自动从那里开始。
3. 不要使用记录集字段索引，除非您需要它来提高性能，因为它会使您的代码难以阅读，并且如果您从查询中删除一个字段，后面的字段的索引会发生变化。请改用字段名。
4. If (IsNull(rs.Fields(12))) Or (CDate(rs.Fields(12)) < currDateTime)fails 因为您不能在 Null 值上使用 CDate。您必须使用Nz或IIf，但您可以跳过IsNullcondition，就好像值为Null，它被设置为低于currDateTime的值。

循环中的所有更新（在 For Each 循环中将字段名添加到数组中）

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