Многочисленные ошибки при обновлении набора записей в таблице доступа

Question

Я ставлю код, который действует как часы времени. Я хочу сделать «умные» часы, в которых я храню время в разных столбцах. Для этого я установил логику, которая: 1. Обновляет столбец "time_in", когда пользователь еще не успел за день 2. Обновляет столбец «Break Out», когда «Time in» не пусто, а «Break Out» пусто 3. Обновляет столбец «Вступление», когда столбцы «Время входа» и «Выйти» не пустые, а «Вступление» 4. Обновляет столбец «Тайм-аут», если все предыдущие столбцы не пусты, но столбец «Тайм-аут» равен

Я не знаю, является ли это лучшим для достижения моей цели, но эту логику я пытаюсь реализовать.

Чтобы достичь этого, я не нашел другого решения, кроме как открыть несколько наборов записей для моего соединения, каждый из которых проверял бы условия выше, но я получал так много ошибок, что даже не знаю, откуда они берутся. Иногда код работает нормально до конца, поле обновляется в таблице Access, иногда я получаю ошибки, такие как «EOF или BOF пусто ...» или «Операция не разрешена в этом контексте» при переходе к оператору обновления

Вот код:

`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`

Может кто-нибудь порадует меня лучше этим кодом? Или, может быть, есть лучший способ подойти к этому ...

PS: Есть несколько слов по-французски, извините. Перевод: Пауза: Перерыв. Heure: час. Matricule: уникальный идентификатор

Answer 1

Не проверено (и при условии, что ваш SQL правильный), но вы, вероятно, могли бы сделать это таким образом с одним набором записей:

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