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

Posted 2023-04-19

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

【英文标题】：Access VBA Runtime Error 3052, file sharing lock count exceeded

【发布时间】：2019-07-25 08:10:56

【问题描述】：

我正在处理一个包含 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

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

【问题讨论】：

在网上搜索错误消息（复制/粘贴），这应该会有所帮助；）

您不想通过循环遍历表格来执行此操作。相反，您想使用 SQL 或查询来执行此操作。您可以从代码或宏运行。创建 > 查询设计 - 选择您的表 > 更新（查询类型）。

【参考方案1】：

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

始终保留您的代码 DRY，因为“湿”代码会腐烂。 如果您使用rs.MoveFirst，您必须检查记录集是否为空，但在刚刚打开的记录集上不需要rs.MoveFirst，它会自动从那里开始。 不要使用记录集字段索引，除非您需要它来提高性能，因为它会使您的代码难以阅读，并且如果您从查询中删除一个字段，后面的字段的索引会发生变化。请改用字段名。 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
...

【讨论】：

If IsNull(rs.Fields(Fieldname).Value) Or CDate(Nz(rs.Fields(Fieldname).Value,#00:00:00#)) < currDatetime Then 可以替换为If CDate(Nz(rs.Fields(Fieldname).Value, 0)) < currDatetime Then

@4dmonster，我的编辑是在您发表评论前 3 秒；）