这段代码为什末出现"文件共享锁定数溢出3052"错误

apeng

Public Function abc()
On Error GoTo Err_Cmdls_Click
CurrentDb.Execute "update 电视剧整理 set 临时=''"
    Dim Rs As New ADODB.Recordset
    Dim date1 As Date
    Dim date2 As Date
    Dim str1 As String
    Dim str2 As String
    Dim xx1 As String
    Dim xx2 As String
    Dim mc1 As String
    Dim mc2 As String
    Rs.Open "电视剧整理", CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdTable
    Rs.MoveFirst
    CurrentDb.Execute "update 电视剧整理 set 临时=名称 "
    Do Until Rs.EOF
    str1 = Rs!临时
    date1 = Rs!开始日期
    xx1 = Rs!合并
    mc1 = Rs!名称
    Rs.MoveNext
    mc2 = Rs!名称
    xx2 = Rs!合并
    date2 = Rs!开始日期
    If xx1 = xx2 And date2 - date1 > 10 Then
    str2 = str1 + "-重"
    Rs!临时 = str2
    ElseIf xx1 = xx2 And date2 - date1 <= 10 Then
    Rs!临时 = str1
    Else
    Rs!临时 = mc2
    End If
    Loop
Rs.Close
Set Rs = Nothing
Exit_Cmdls_Click:
    Exit Function

Err_Cmdls_Click:
  If err.Number = 3021 Then
  MsgBox "结果已经生成！", vbInformation, "提示："
  Resume Exit_Cmdls_Click
  End If
    MsgBox err.Description & err.Number
    Resume Exit_Cmdls_Click
   
End Function

haemon

最好是附上数据库

tmtony

有两个方法解决:

1.修改注册表 HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Jet\3.5\Engines\Jet 3.5 (如果是4.0版本改为4.0) 将MaxLocksPerFile改到足够大 (但注意也不要太贪心

2.在运行你的程序之前运行下面的函数:
Sub LargeUpdate()
      On Error GoTo LargeUpdate_Error
      Dim db As Database, ws As Workspace

      ' Set MaxLocksPerFile.
      DBEngine.SetOption dbMaxLocksPerFile, 200000

      Set db = CurrentDb
      Set ws = Workspaces(0)

      ' Perform the update.
      ws.BeginTrans
      db.Execute "UPDATE LargeTable SET Field1 = 'Updated Field'", _
         dbFailOnError
      ws.CommitTrans

      db.Close
      MsgBox "Done!"
      Exit Sub

   LargeUpdate_Error:

      MsgBox Err & " " & Error
      ws.Rollback
      MsgBox "Operation Failed - Update Canceled"
      Exit Sub

   End Sub