Question

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

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

Answer 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()做同样的事情。

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

Answer 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

运行DAO记录集时记录重复

2 个答案: