运行 DAO 记录集时出现重复记录答案

【问题标题】：Duplicate records when running a DAO recordset运行 DAO 记录集时出现重复记录
【发布时间】：2019-02-28 10:22:53
【问题描述】：

我开发了一个访问数据库来记录整个生产过程中的作业。每条记录都有订单、机器、开始时间、结束时间以及作业的其他特征。当订单被记录时，它与机器名称、开始时间和作业状态（运行或空闲）一起保存在数据库中。订单完成后，使用记录集搜索记录并保存“结束时间”。如果机器没有被使用，比如在轮班之间，机器应该处于“空闲”状态。

OpenRecMassUpdate 的目的是为所有不完整的记录添加一个“结束时间”（那些有顺序、开始时间但没有结束时间的记录）。这段代码在班次结束时使用，以便一键关闭所有记录。

执行此子程序后，分配给订单的机器现在没有状态。结果，我需要另一个子程序来为所有这些机器添加“空闲”状态。这就是 MassIdleUpdate 的目的。它为以前使用过的每台机器创建一个空闲记录，并使用 OpenRecMassUpdate 关闭状态。

我面临的问题是 MassIdleUpdate 会随机创建多条记录。当我对数据库进行分析时，我发现一些记录被创建了 3 次、4 次或更多次。

Option Compare Database

Dim dbsn As DAO.Database
Dim rstn As DAO.Recordset
Dim SQLqueryn As String
Dim recordcount As Integer
Dim tempstat As String
Dim stat1 As Integer

Public Sub OpenRecMassUpdate()

  On Error GoTo ErrorHandler

  recordcount = 1
  tempstat = "Idle"
  stat1 = 0
  Set dbsn = CurrentDb

  SQLqueryn = "SELECT * FROM kettleLog WHERE KettleStatus <> """ & tempstat & _
              """ And KettleLogic = " & stat1

  Set rstn = dbsn.OpenRecordset(SQLqueryn)
  With rstn
    If Not .BOF And Not .EOF Then
      .MoveLast
      .MoveFirst
      While (Not .EOF)
        .Edit
        .Fields("KettleFinish") = Now()
        .Fields("KettleLogic") = -1
        .Fields("EndOfShift") = 1
        .Update
        .MoveNext
        recordcount = recordcount + 1
      Wend
      MsgBox recordcount - 1 & " records were updated as a result of the end of the shift"
      recordcount = 1
    Else
    End If
    .Close
  End With

  dbsn.Close

ExitSub:
  Set dbsn = Nothing
  Set rstn = Nothing
  Exit Sub

ErrorHandler:
  MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
  Resume ExitSub

End Sub

Public Sub MassIdleUpdate()

  Dim tempKettle As String

  On Error GoTo ErrorHandler
  Set dbsn = CurrentDb

  SQLqueryn = "SELECT * FROM kettleLog WHERE EndOfShift = 1"

  Set rstn = dbsn.OpenRecordset(SQLqueryn)
  With rstn
    If Not .BOF And Not .EOF Then
      .MoveLast
      .MoveFirst
      For i = 1 To FindRecordCount(SQLqueryn)
        tempKettle = .Fields("Kettle")
        .Edit
        .Fields("EndOfShift") = 3
        .Update
        .AddNew
        .Fields("Kettle") = tempKettle
        .Fields("KettleStatus") = "Idle"
        .Fields("WorkOrder") = 0
        .Fields("KettleStart") = Now()
        .Fields("KettleLogic") = 0
        .Fields("EndOfShift") = 2
        .Update
        .MoveNext
      Next
    End If
    .Close
  End With

  tempKetlle = ""
  dbsn.Close
  i = 1

ExitSub:
  Set dbsn = Nothing
  Set rstn = Nothing

  Exit Sub

ErrorHandler:
  MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
  Resume ExitSub

End Sub

【问题讨论】：

如果你不打算使用.RecordCount，为什么还要.MoveLast 然后.MoveFirst？
@MathieuGuindon 我读到这是在对记录集进行任何操作之前的一个好习惯。
@MathieuGuindon 我以不同的方式提出了我的问题。除此之外，我添加了更多关于这个子程序发生了什么的细节。
您需要调试MassIdleUpdate的单次运行并分析结果。该代码永远不会遍历EndOfShift=1 所在的所有记录，因为您的循环会随着每次迭代而动态变短。我的猜测是用户多次单击您的按钮以试图获得所需的结果。请在运行该代码一次后发布有关记录状态的详细信息（即从 30 条记录开始，只有 15 条更新为 3 等）。还发布有关 FindRecordCount 正在做什么的详细信息。如果它像名字所暗示的那样做，那是你的问题之一。
在Sub OpenRecMassUpdate() 你有一个Else 里面什么都没有。那里应该有什么东西吗？如果没有，您可以删除它 - 它所做的只是引起问题。

标签： ms-access vba ms-access-2010 recordset

【解决方案1】：

与其循环遍历所有记录并计算它们并单独设置值，不如一次性完成。 RDBMS（甚至 Access）就是为这种批量更新而设计的。

Public Sub OpenRecMassUpdate()

  On Error GoTo ErrorHandler

  Dim tempStat As String
  tempStat = "Idle"
  Dim stat1 As Long
  stat1 = 0
  Set dbsn = CurrentDb

  Dim timeStamp As Date
  timeStamp = Now()
  SQLqueryn = "UPDATE KettleLog " & _
              "   SET KettleFinish = #" & timeStamp & "#, " & _
              "       KettleLogic = -1, " & _
              "       EndOfShift = 1 " & _
              " WHERE KettleStatus <> """ & tempStat & """" & _
              "   AND KettleLogic = 0"

  Set rstn = dbsn.OpenRecordset(SQLqueryn)
  rstn.Close

  SQLqueryn = "SELECT Count(*) " & _
              "  FROM KettleFinish " & _
              " WHERE KettleFinish = #" & timeStamp & #", " & _
              "   AND KettleLogic = -1 " & _
              "   AND EndOfShift = 1"
  Set rstn = dbsn.OpenRecordset(SQLqueryn)
  If Not rstn.BOF And Not rstn.EOF Then
    rstn.MoveLast
    Dim recordcount As Long
    recordcount = rstn.recordcount
  End If
  MsgBox recordcount & " records were updated as a result of the end of the shift"
  rstn.Close
  dbsn.Close

ExitSub:
  Exit Sub

ErrorHandler:
  MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
  Resume ExitSub

End Sub

^{注意：我习惯于 ADO 语法，而不是 DAO，因此可能需要进行一两次小的调整，但这应该可以帮助您入门}

这将完成您的 OpenRecMassUpdate() 过程在 2 个 SQL 查询中所做的事情，而不是那个耗时的循环。

你也可以对Sub MassIdleUpdate()做同样的事情。

事实上，只要稍加一点创意，您就可以将两者合二为一，尽管将它们分开可以降低复杂性，提高可读性，从而提高未来的可维护性。

【讨论】：

这是我解决方案的一种非常优雅的方法！我将在我的沙盒中尝试此操作并告知结果。
由于您似乎最终希望 EndOfShift 为 3，您可以简单地首先设置它并使用 KettleFinish = timeStamp 作为标识符来查找您所追求的记录并执行所有MassIdleUpdate 在单个 INSERT ... SELECT 语句中的工作。
非常感谢您的帮助。根据您的建议，我能够找到更新记录的更好方法。还有一件事，在我使用 j 作为计数器的情况下进行循环是否是一种更好的方法？如果您能给我您的反馈，我将不胜感激。

【解决方案2】：

感谢@Freeman 引导我朝着正确的方向前进。这是我遇到的问题的解决方案。该代码已在我的沙箱中使用不同的场景进行了测试，并且可以正常工作。

Public Sub OpenRecMassUpdate1()

On Error GoTo ErrorHandler

Dim tempStat As String
tempStat = "Idle"
Dim stat1 As Long
stat1 = 0
Set dbsn = CurrentDb

Dim timeStamp As Date
timeStamp = Now()
SQLqueryn = "UPDATE KettleLog " & _
            "   SET KettleFinish = #" & timeStamp & "#, " & _
            "       KettleLogic = -1, " & _
            "       EndOfShift = 1 " & _
            " WHERE KettleStatus <> """ & tempStat & """" & _
            "   AND KettleLogic = 0"

dbsn.Execute SQLqueryn, dbFailOnError

SQLqueryn = "SELECT Count(*) " & _
            "AS RecCount " & _
            "  FROM KettleLog " & _
            " WHERE KettleLogic = -1 " & _
            "   AND EndOfShift = 1"

Set rstn = dbsn.OpenRecordset(SQLqueryn)

If Not rstn.BOF And Not rstn.EOF Then
Dim recordcount As Long
recordcount = rstn![RecCount]
End If

MsgBox recordcount & " records were updated as a result of the end of the shift"
rstn.Close
dbsn.Close

ExitSub:
Exit Sub

ErrorHandler:
MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
Resume ExitSub

End Sub

Public Sub MassIdleUpdate1()

On Error GoTo ErrorHandler

Dim TempKettle As String
Set dbsn = CurrentDb
SQLqueryn = "SELECT * " & _
            "  FROM KettleLog " & _
            "  WHERE EndOfShift = 1"

Set rstn = dbsn.OpenRecordset(SQLqueryn)
rstn.MoveLast
Dim rcrdcnt As Long
rcrdcnt = rstn.recordcount
ReDim machs(rcrdcnt) As String
'MsgBox rcrdcnt

rstn.MoveFirst
If Not rstn.BOF And Not rstn.EOF Then


For i = 0 To rcrdcnt - 1
machs(i) = rstn.Fields("Kettle")
rstn.MoveNext
Next
End If



SQLqueryn = "UPDATE KettleLog " & _
        " SET EndOfShift = 3 " & _
        " WHERE EndOfShift = 1 "

dbsn.Execute SQLqueryn, dbFailOnError

For j = 0 To rcrdcnt

SQLqueryn = "INSERT INTO KettleLog (Kettle, KettleStatus, WorkOrder, KettleStart, 
KettleLogic, EndOfShift) " & _
            " VALUES ( '" & machs(j) & "' , 'Idle', '0', #" & Now() & "#, '0', '2')"
MsgBox SQLqueryn
dbsn.Execute SQLqueryn, dbFailOnError

machs(j) = ""
Next
rstn.Close
dbsn.Close

ExitSub:
Exit Sub

ErrorHandler:
MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description
Resume ExitSub
End Sub

【讨论】：