Duplicate records when running a DAO recordset - ms-access

Question

I developed an access database to log jobs throughout a production process. Every record has an order, machine, start time, end time among other characteristics of the job. When an order is logged, it is saved in the database along with the machine name, start time and job status (running or idle). When the order is completed, the record is searched using a recordset and "end time" is saved. If the machine is not being utilized, like between shifts, the machine should have an "idle" status.
The purpose of OpenRecMassUpdate is to add an 'end time' to all the incomplete records (those with an order, start time but without end time). This code is used at the end of shift so that all the records could be closed with one click.
After executing this subroutine, the machines that were assigned to an order are now without a status. As a result, I needed another subroutine to add "idle" statuses to all these machines. That is the purpose of MassIdleUpdate. It creates an idle record for every machine that was previously used and status closed using OpenRecMassUpdate.
The problem I am facing is that MassIdleUpdate creates multiple records at random times. When I run analysis on the database, I found some records that were created 3, 4 or more times.
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

Instead of looping through all your records counting them and setting the values individually, do it all in one shot. An RDBMS (even Access) is designed for this kind of bulk update.
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
Note: I'm used to ADO syntax, not DAO, so there might be a minor tweak or two needed, but this should get you started
This will do what your OpenRecMassUpdate() procedure was doing in precisely 2 SQL queries instead of that time consuming loop.
You can also do the same thing to Sub MassIdleUpdate().
As a matter of fact, with a little creativity, you could probably combine the two of them into one, though keeping them separate reduces complexity, improves readability and, thus, future maintainability.

Answer 2

Thanks to #Freeman who guided me in the right direction. Here's my solution to the issue I had. The code has been tested in my sandbox using different scenarios and it works.
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