Question

我正在为其设置代码，以充当时钟。我想制作一个“智能”时钟，将时间输入/输出存储在不同的列中。为此，我建立了以下逻辑： 1.当用户当天尚未登录时，更新“ time_in”列 2.当“ Time in”不为空且“ Break Out”为空时，更新“ Break Out”列 3.当“时间输入”和“中断输出”列都不为空但“中断输入”为空时，更新“中断输入”列 4.只要前一列的所有内容都不为空，但“ Time Out”列为空，则更新“ Timeout”列

我不知道这是否是实现目标的最佳选择，但这就是我要尝试实现的逻辑。

要实现这一目标，我没有找到其他解决方案，只能为我的连接打开多个记录集，每个记录集都检查上述条件，但是我收到了太多错误，甚至不知道它们来自何处。有时代码可以正常工作，直到在Access表中更新该字段为止，有时在进入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`

有人可以让我更好的代码吗？或者也许有更好的方法来解决这个问题……

PS：抱歉，法语里有些话。翻译：暂停：休息。 Heure：小时。矩阵：唯一ID

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

将记录集更新到Access表中时发生多个错误

1 个答案: