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

Question

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

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

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

我想使用 if 或缩短我的代码，但是当我使用如果 (IsNull(rs.字段(12((( 或 (CDate(rs.字段(12((

它将向我显示无效的空用法。

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. 始终保持代码干燥，因为"湿"代码会腐烂。
2. 如果您使用 rs.MoveFirst ，则必须检查记录集是否为空，但不需要在刚刚打开的记录集上rs.MoveFirst，它会自动从那里开始。
3. 不要使用记录集字段索引，除非为了提高性能而需要它，因为这会使代码难以阅读，并且如果从查询中删除字段，则后面字段的索引会更改。请改用字段名称。
4. If (IsNull(rs.Fields(12))) Or (CDate(rs.Fields(12)) < currDateTime)失败，因为不能对空值使用 CDate。您必须使用 Nz 或 IIf ，但您可以跳过IsNull条件，如果值为 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
...