Excel 将记录集更新到Access表时出现多个错误

我正在设置一个代码作为时钟。我想做一个“智能”时钟，在这里我把时间输入/输出存储在不同的列中。为此，我建立了一个逻辑： 1.当用户当天尚未打卡时，更新“time_in”列 2.当“时间”不为空且“中断”为空时，更新“中断”列 3.当“时间进入”和“中断”列均不为空但“中断”为空时，更新“中断”列 4.只要前一列不是空的，但“超时”列是空的，则更新“超时”列

我不知道这是否是实现我目标的最佳方式，但这正是我试图实现的逻辑

为了实现这一点，我没有找到其他解决方案，只能为我的连接打开多个记录集，每个记录集都在检查上述条件，但我收到的错误太多了，我甚至不知道它们来自何处。有时代码工作正常，直到访问表中的字段被更新为止，有时在到达update语句时，我会遇到诸如“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`

有人能帮我把这个密码改好吗？或者也许有更好的方法来解决这个问题

附言：有一些法语单词，对不起。暂停：休息。休尔：一小时。Matricule:Unique ID

未经测试（假设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

---

嗨，Tim，你知道为什么我的代码会呈现这些错误吗？我知道这是一个有点过于复杂的原因，但在我看来，这是合乎逻辑的，因此应该没有明显的问题工作。。。提前感谢我不能肯定-您打开了很多记录集，同一条记录的值可能大于1，因此这可能是一个问题。除了

rs