Multiple errors while updating a recordset into Access table

Question

I am putting in place a code for that acts as a time clock. I want to make a "smart" time clock where I store time in/out in different columns. To do that, I have set up a logic that: 1. Updates the "time_in" column when the user has not clocked in yet for the day 2. Updates the "Break Out" column when the "Time in" is not empty and the "Break Out" is empty 3. Updates the "Break In" column when both "Time in" and "Break Out" columns are not empty but "Break In" is 4.Updates the "Time Out" column whenever all the previous column are not empty but "Time Out" column is

I don't know if this is the best to achieve my goal, but that's the logic I am trying to implement.

To achieve this, I found no other solution but to have multiple recordset open for my connection, each one checking for the conditions above but I am getting so many errors that I don't even know where they are coming from. Sometimes the code works fine till the end the field is updated in the Access table, sometimes I get errors like 'Either EOF or BOF is empty...' or "Operation not allowed in this context" when getting to the update statement

Here is the code:

`Private Sub CommandButton1_Click()
 Dim conn As Object
 Dim rs As Object
 Dim rs2 As Object
 Dim rs3 As Object
 Dim rs4 As Object
 Dim rs5 As Object
 Dim rs6 As Object
 Dim strconn As String
 Dim qry As String
 Dim sql As String
 Dim extrct As String
 Dim extrct2 As String
 Dim extrct3 As String
 Dim extrct4 As String
 Dim BadgeId As String

 Set conn = CreateObject("ADODB.connection")
 Set rs = CreateObject("ADODB.Recordset")
 Set rs2 = CreateObject("ADODB.Recordset")
 Set rs3 = CreateObject("ADODB.Recordset")
 Set rs4 = CreateObject("ADODB.Recordset")
 Set rs5 = CreateObject("ADODB.Recordset")
 Set rs6 = CreateObject("ADODB.Recordset")

 strconn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data source = [Path]"
 qry = "select * from pointage"
 sql = "select * from employes where actif='Yes' and matricule=" & Val(POINTAGE.PointMatricule)
 extrct = "select * from pointage where matricule=" & Me.PointMatricule & " " & "and fix(date_prestation)= Date()"
 extrct2 = "select * from pointage where matricule=" & Me.PointMatricule & " and fix(date_prestation)= Date()" & " and pause_out is null"
 extrct3 = "select * from pointage where matricule=" & Me.PointMatricule & " and fix(date_prestation)= Date()" & " and pause_out is not null" & " and pause_in is null"
 extrct4 = "select * from pointage where matricule=" & Me.PointMatricule & " and fix(date_prestation)= Date()" & " and pause_out is not null" & " and pause_in is not null" & " and heure_out is null"

 conn.Open (strconn)

 rs.Open qry, conn, adOpenKeyset, adLockOptimistic, adCmdText
 rs2.Open sql, conn, adOpenKeyset, adLockOptimistic, adCmdText
 rs3.Open extrct, conn, adOpenKeyset, adLockOptimistic, adCmdText
 rs4.Open extrct2, conn, adOpenKeyset, adLockOptimistic, adCmdText
 rs5.Open extrct3, conn, adOpenKeyset, adLockOptimistic, adCmdText
 rs6.Open extrct4, conn, adOpenKeyset, adLockOptimistic, adCmdText
 If rs3.EOF And rs3.BOF Then
 With rs
.AddNew
.Fields("matricule").Value = Me.PointMatricule
.Fields("date_prestation").Value = Format(Date, "dd/mm/yyyy")
.Fields("heure_in").Value = Format(Time, "hh:mm:ss")
 End With

 GoTo 3
 ElseIf Not (rs4.EOF And rs4.BOF) Then
 With rs4
    .Fields("pause_out").Value = Format(Time, "hh:mm:ss") 'Error:  Either EOF or BOF...
 End With
 ElseIf Not (rs5.EOF And rs5.BOF) Then
 With rs5
 .Fields("pause_in").Value = Format(Time, "hh:mm:ss")
  End With
  ElseIf Not (rs6.EOF And rs6.BOF) Then
  With rs6
 .Fields("pause_out").Value = Format(Time, "hh:mm:ss")
  End With
  end if
  rs.Update

  rs.Close
  Set rs = Nothing
  rs2.Close
  Set rs2 = Nothing
  rs3.Close
  Set rs3 = Nothing ' From here on is where I get errors: Not allowed...
  rs4.Close
  Set rs4 = Nothing
  rs5.Close
  Set rs5 = Nothing
  rs6.Close
  Set rs6 = Nothing

  conn.Close
  Set conn = Nothing
  end sub`

Can someone please me better this code? Or maybe there is a better way to approach this...

PS: There are some words in french, sorry. Translation: Pause: Break. Heure: Hour. Matricule: Unique ID

Answer 1

Untested (and assuming your SQL is correct) but you could probably do it this way with a single recordset:

Private Sub CommandButton1_Click()

    Dim conn As Object
    Dim rs As Object
    Dim strconn As String
    Dim extrct As String, tm

    Set conn = CreateObject("ADODB.connection")
    strconn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data source = [Path]"
    conn.Open strconn

    Set rs = CreateObject("ADODB.Recordset")
    extrct = "select * from pointage where matricule=" & Me.PointMatricule & _
             " and fix(date_prestation)= Date()"
    tm = Format(Time, "hh:mm:ss")
    rs.Open extrct, conn, adOpenKeyset, adLockOptimistic, adCmdText
    With rs
        If .EOF Then
            'no entry yet for today...
            .AddNew
            .Fields("matricule").Value = Me.PointMatricule
            .Fields("date_prestation").Value = Date  ' Format(Date, "dd/mm/yyyy")
            .Fields("heure_in").Value = tm
        Else
            'have an entry for today - figure out which field to update
            If IsNull(.Fields("pause_out")) Then
                .Fields("pause_out").Value = tm
            ElseIf IsNull(.Fields("pause_in")) Then
                .Fields("pause_in").Value = tm
            ElseIf IsNull(.Fields("heure_out")) Then
                .Fields("heure_out").Value = tm
            End If
        End If
        .Update 'save changes
        .Close
    End With

    conn.Close
    Set conn = Nothing
End Sub