FindFirst NoMatch 基于 Access 2007 表中的 2 列

Posted 2023-05-06

【中文标题】FindFirst NoMatch 基于 Access 2007 表中的 2 列

【英文标题】：FindFirst NoMatch Based on 2 Columns in Access 2007 Table

【发布时间】：2016-06-09 15:53:31

【问题描述】：

对于这个冗长的问题，我提前向您道歉，我只是想说明一下，我对 VBA 编程非常陌生，并且愿意接受更改代码以使数据库更快、更顺畅地运行而不会丢失当前功能的建议.

我创建的是用于安排患者的表格。该表单包含一个子表单，它根据在文本框和两个组合框中选择的内容显示记录。首先，用户选择第一个组合框中列出的医生 (DoctorsName)，选择日期 (txtApppointDate)。然后，可用时间组合框 (cboTime) 填充并显示基于 DoctorsName 和 txtApppointDate 选择的可用时间。

所以我想要做的是有一个按钮或复选框控件，当它被选中时，它会自动填充具有开放时间段的下一个日期并显示在 txtAppointDate 字段中。除了按钮或复选框之外，我对任何其他选项都很好，但我只是在寻找一种让用户简单地查找下一个可用日期/时间的方法。我熟悉 FindFirst 和 NoMatch 属性，但不太确定它们在这种情况下如何工作。

下面是我的代码。非常感谢您的帮助！

Private Sub cboTime_Enter()
    Dim i As Date, n As Integer, oRS As DAO.Recordset, sSQL As String
    Dim dDuration As Date, dEnd As Date, dStart As Date
    Dim dLowerPrecision As Date, dUpperPrecision As Date
    cboTime.RowSourceType = "Value List"
    cboTime.RowSource = ""
    If IsNull(Start) Then Exit Sub Else i = Start
    If Me.NewRecord = True Then
        DoCmd.RunCommand acCmdSaveRecord
    End If
    sSQL = "SELECT DoctorsID, AppointDate, AppointTime"
    sSQL = sSQL & " FROM qrySubformAppoints"
    sSQL = sSQL & " WHERE DoctorsID= " & Me.ID & _
                            " AND AppointDate=#" & Me.txtAppointDate & "#"
    Set oRS = CurrentDb.OpenRecordset(sSQL)
    dDuration = TimeValue("00:30")
    If Weekday(Me.txtAppointDate, vbSaturday) = 3 Then
        dEnd = EndMon - TimeValue("00:25")
        dStart = StartMon - TimeValue("00:25")
    ElseIf Weekday(Me.txtAppointDate, vbSaturday) = 4 Then
        dEnd = EndTues - TimeValue("00:25")
        dStart = StartTues - TimeValue("00:25")
    ElseIf Weekday(Me.txtAppointDate, vbSaturday) = 5 Then
        dEnd = EndWed - TimeValue("00:25")
        dStart = StartWed - TimeValue("00:25")
    ElseIf Weekday(Me.txtAppointDate, vbSaturday) = 6 Then
        dEnd = EndThurs - TimeValue("00:25")
        dStart = StartThurs - TimeValue("00:25")
    Else
        dEnd = EndFri - TimeValue("00:25")
        dStart = StartFri - TimeValue("00:25")
    End If
    If oRS.RecordCount = 0 Then
        Do
            If i >= dStart And i <= dEnd Then
                cboTime.AddItem i
            End If
            i = i + dDuration
        Loop Until i >= dEnd
    Else
        Do
            If i >= dStart And i <= dEnd Then
                dLowerPrecision = i - TimeValue("00:00:05")
                dUpperPrecision = i + TimeValue("00:00:05")
                oRS.FindFirst "[AppointTime] Between #" & dLowerPrecision & "# And #" & dUpperPrecision & "#"
                If oRS.NoMatch Then cboTime.AddItem i
            End If
            i = i + dDuration
        Loop Until i >= dEnd
    End If
    oRS.Close
End Sub
Private Sub cboTime_AfterUpdate()
    subform.SetFocus
    DoCmd.GoToControl "AppointTime"
    DoCmd.GoToRecord , , acNewRec
    subform.Form.Controls("AppointTime") = Me.cboTime
    subform.Form.Controls("AppointDate") = Me.txtAppointDate
    subform.Form.Controls("cboClient").SetFocus
    subform.Form.Controls("cboClient").Dropdown
End Sub
Private Sub txtAppointDate_BeforeUpdate(Cancel As Integer)
    If Weekday(Me.txtAppointDate, vbSaturday) <= 2 Then
    Cancel = True
    MsgBox ("No appointments available on this date")
    End If
    If Me.ID = 1 And Weekday(Me.txtAppointDate, vbSaturday) = 3 Then
    Cancel = True
    MsgBox ("No appointments available on this date")
    End If
    If Me.ID = 1 And Weekday(Me.txtAppointDate, vbSaturday) = 4 Then
    Cancel = True
    MsgBox ("No appointments available on this date")
    End If
    If Me.ID = 1 And Weekday(Me.txtAppointDate, vbSaturday) = 6 Then
    Cancel = True
    MsgBox ("No appointments available on this date")
    End If
    If Me.ID = 2 And Weekday(Me.txtAppointDate, vbSaturday) = 3 Then
    Cancel = True
    MsgBox ("No appointments available on this date")
    End If
    If Me.ID = 2 And Weekday(Me.txtAppointDate, vbSaturday) = 4 Then
    Cancel = True
    MsgBox ("No appointments available on this date")
    End If
    If Me.ID = 2 And Weekday(Me.txtAppointDate, vbSaturday) = 6 Then
    Cancel = True
    MsgBox ("No appointments available on this date")
    End If
    If Me.ID = 4 And Weekday(Me.txtAppointDate, vbSaturday) = 3 Then
    Cancel = True
    MsgBox ("No appointments available on this date")
    End If
    If Me.ID = 4 And Weekday(Me.txtAppointDate, vbSaturday) = 4 Then
    Cancel = True
    MsgBox ("No appointments available on this date")
    End If
    If Me.ID = 4 And Weekday(Me.txtAppointDate, vbSaturday) = 6 Then
    Cancel = True
    MsgBox ("No appointments available on this date")
    End If
    If Me.ID = 6 And Weekday(Me.txtAppointDate, vbSaturday) = 3 Then
    Cancel = True
    MsgBox ("No appointments available on this date")
    End If
    If Me.ID = 6 And Weekday(Me.txtAppointDate, vbSaturday) = 4 Then
    Cancel = True
    MsgBox ("No appointments available on this date")
    End If
    If Me.ID = 6 And Weekday(Me.txtAppointDate, vbSaturday) = 6 Then
    Cancel = True
    MsgBox ("No appointments available on this date")
    End If
End Sub

【参考方案1】：

您可以使用更简洁的选择案例来简化相当多的长嵌套 If / Elseif 部分。至于移动到所需的记录集，请尝试记录克隆，如果找到匹配原始记录集中的书签位置。

    Private Sub cboTime_Enter()
    Dim i As Date, n As Integer, oRS As DAO.Recordset, sSQL As String
    Dim dDuration As Date, dEnd As Date, dStart As Date
    Dim dLowerPrecision As Date, dUpperPrecision As Date
    Dim rs As Object
    cboTime.RowSourceType = "Value List"
    cboTime.RowSource = ""
    If IsNull(Start) Then Exit Sub Else i = Start
    If Me.NewRecord = True Then
        DoCmd.RunCommand acCmdSaveRecord
    End If
    sSQL = "SELECT DoctorsID, AppointDate, AppointTime"
    sSQL = sSQL & " FROM qrySubformAppoints"
    sSQL = sSQL & " WHERE DoctorsID= " & Me.ID & _
                            " AND AppointDate=#" & Me.txtAppointDate & "#"
    Set oRS = CurrentDb.OpenRecordset(sSQL)
    dDuration = TimeValue("00:30")

    Select Case Weekday(Me.txtAppointDate, vbSaturday)
        Case 3,4,5,6
            dEnd = End - TimeValue("00:25")
            dStart = Start - TimeValue("00:25")
        Case else
            dEnd = End - TimeValue("00:25")
            dStart = Start - TimeValue("00:25")
    End Select

    If oRS.RecordCount = 0 Then
        Do
            If i >= dStart And i <= dEnd Then
                cboTime.AddItem i
            End If
            i = i + dDuration
        Loop Until i >= dEnd
    Else
        Do
            If i >= dStart And i <= dEnd Then
                dLowerPrecision = i - TimeValue("00:00:05")
                dUpperPrecision = i + TimeValue("00:00:05")
                Set rs = Me.RecordsetClone    
                rs.FindFirst "[AppointTime] Between #" & dLowerPrecision & "# And #" & dUpperPrecision & "#"
                If Not rs.EOF Then 
                    Me.Bookmark = rs.Bookmark
                Then
                    cboTime.AddItem i
                End if
            End If
            i = i + dDuration
        Loop Until i >= dEnd
    End If
    oRS.Close
End Sub
Private Sub cboTime_AfterUpdate()
    subform.SetFocus
    DoCmd.GoToControl "AppointTime"
    DoCmd.GoToRecord , , acNewRec
    subform.Form.Controls("AppointTime") = Me.cboTime
    subform.Form.Controls("AppointDate") = Me.txtAppointDate
    subform.Form.Controls("cboClient").SetFocus
    subform.Form.Controls("cboClient").Dropdown
End Sub
Private Sub txtAppointDate_BeforeUpdate(Cancel As Integer)

    Select Case Weekday(Me.txtAppointDate, vbSaturday)
        Case IS <=2, 3,4,6          
            Cancel = True
            MsgBox ("No appointments available on this date")
        Case else
            'nothing?
    End Select  

End Sub