vendredi 17 juin 2016

FindFirst NoMatch Based on 2 Columns in Access 2007 Table

I apologize in advance for this lengthy question and just want to put it out there that I am very new to VBA programming and am open to suggestions to change code to allow the database to run more quickly and smoothly without losing the current functionality.

What I've created is a form used to schedule patients. The form contains a subform that displays records based on what is selected in a text box and two combo boxes. First, the user chooses a doctor listed in the first combobox (DoctorsName), selects a date (txtAppointDate). Then, the Available Times combobox (cboTime) populates and displays times available based on DoctorsName and txtAppointDate selections.

So what I'm trying to do is have a button or checkbox control that when selected, it automatically populates the next date with an open time slot and displays in the txtAppointDate field. I am fine with any other options besides a button or checkbox but am just looking for a way for users to simply look for the next available date/time. I am familiar with the FindFirst and NoMatch properties but am not quite sure how they would work in this instance.

Below is my code. Thanks so much for the help!

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

Aucun commentaire:

Enregistrer un commentaire