运行 DAO 记录集时重复记录
Duplicate records when running a DAO recordset
我开发了一个访问数据库来记录整个生产过程中的作业。每条记录都有订单、机器、开始时间、结束时间以及作业的其他特征。记录订单时，它会连同机器名称、开始时间和工作状态（运行宁或闲置）一起保存在数据库中。订单完成后，使用记录集搜索记录并保存 "end time"。如果机器没有被使用，比如在轮班之间，机器应该有一个 "idle" 状态。
OpenRecMassUpdate 的目的是为所有不完整的记录（有顺序，开始时间但没有结束时间的）添加一个'end time'。此代码在班次结束时使用，可以一键关闭所有记录。
执行此子例程后，分配给订单的机器现在没有状态。结果，我需要另一个子例程来为所有这些机器添加 "idle" 状态。这就是 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
与其遍历所有记录并单独设置值，不如一次完成所有操作。 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()做同样的事情。
事实上，只要稍加创意，您就可以将两者合而为一，尽管将它们分开可以降低复杂性、提高可读性，从而提高未来的可维护性。
感谢@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
我开发了一个访问数据库来记录整个生产过程中的作业。每条记录都有订单、机器、开始时间、结束时间以及作业的其他特征。记录订单时，它会连同机器名称、开始时间和工作状态（运行宁或闲置）一起保存在数据库中。订单完成后，使用记录集搜索记录并保存 "end time"。如果机器没有被使用，比如在轮班之间，机器应该有一个 "idle" 状态。
OpenRecMassUpdate 的目的是为所有不完整的记录（有顺序，开始时间但没有结束时间的）添加一个'end time'。此代码在班次结束时使用，可以一键关闭所有记录。
执行此子例程后，分配给订单的机器现在没有状态。结果，我需要另一个子例程来为所有这些机器添加 "idle" 状态。这就是 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
与其遍历所有记录并单独设置值，不如一次完成所有操作。 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()做同样的事情。
事实上，只要稍加创意，您就可以将两者合而为一，尽管将它们分开可以降低复杂性、提高可读性，从而提高未来的可维护性。
感谢@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