I have a program that populates a list box with appointment times. It checks to see if the person is available and not already booked and populates the list with available times. I have now introduced an out of office system which allows the user to book time out, could be a couple of hours or a few days. The days one I have covered and it informs the appointment creator that the person is out of the office on that day. It is the time section. This is held in an unavailable file with date and time out from and to. This is where I have the problem. I need to remove these times from my value list. Any help would be great. This is my code.
Private Sub cboTime_Enter()
Dim i As Date, t As Date, n As Integer, oRS As DAO.Recordset, sSQL As String
Dim dLowerbreak As Date, dUpperBreak As Date, dDuration As Date
Dim dLowerPrecision As Date, dUpperPrecision As Date
Dim tSQL As String, tRS As DAO.Recordset
Dim tmpStart, tmpEnd, tmpBreak As Date
Dim n As Integer
Dim tmpcnt As Integer
Dim tmpListItem As Date
sSQL = "SELECT * FROM Unavailable WHERE #" & Me.txtAppointDate & "#>= DateFrom AND #" & Me.txtAppointDate & "#<= DateTo AND CounsellorID= " & Me.UserID & ""
Set oRS = CurrentDb.OpenRecordset(sSQL)
If oRS.RecordCount = 0 Then
Else
MsgBox "The Counsellor Selected is unavailable on the date selected, Please try another date"
Me.txtAppointDate.SetFocus
sSQL = ""
Set oRS = Nothing
Exit Sub
End If
'Set oRS = Nothing
'sSQL = ""
tmpStart = DLookup("[Start]", "tblUsers", "UserID =" & Nz([UserID], 0))
tmpEnd = DLookup("[End]", "tblUsers", "UserID =" & Nz([UserID], 0))
tmpBreak = DLookup("[Break]", "tblUsers", "UserID =" & Nz([UserID], 0))
cboTime.RowSourceType = "Value List"
cboTime.RowSource = ""
If IsNull(tmpStart) Then Exit Sub Else i = tmpStart
If Me.NewRecord = True Then
DoCmd.RunCommand acCmdSaveRecord
End If
sSQL = "SELECT appCounsellor, AppDate, StartTime"
sSQL = sSQL & " FROM qrySubformAppointments"
sSQL = sSQL & " WHERE appCounsellor= " & Me.UserID & _
" AND AppDate=#" & Me.txtAppointDate & "#"
Set oRS = CurrentDb.OpenRecordset(sSQL)
dDuration = TimeValue("01:00")
dLowerbreak = tmpBreak - TimeValue("00:25") 'Break is a field
dUpperBreak = tmpBreak + TimeValue("00:25")
tSQL = "SELECT TimeFrom, TimeTo FROM Unavailable WHERE #" & Me.txtAppointDate & "#= DateTime AND CounsellorID= " & Me.UserID & ""
Set tRS = CurrentDb.OpenRecordset(tSQL)
If oRS.RecordCount = 0 Then
Do
If i <= dLowerbreak Or i >= dUpperBreak Then
cboTime.AddItem i
End If
i = i + dDuration
Loop Until i >= tmpEnd
Else
Do
If i <= dLowerbreak Or i >= dUpperBreak Then
dLowerPrecision = i - TimeValue("00:00:05")
dUpperPrecision = i + TimeValue("00:00:05")
oRS.FindFirst "[StartTime] Between #" & dLowerPrecision & "# And #" & dUpperPrecision & "#"
If oRS.NoMatch Then cboTime.AddItem i
End If
i = i + dDuration
Loop Until i >= tmpEnd
End If
oRS.Close
How can I then scroll through my cboTime.RowSource and remove the times that fall between tRS!StartTime and TRS!EndTime. These are all in one hour intervals. Any help whatsoever would be greatly appreciated.
Private Sub cboTime_Enter()
Dim i As Date, t As Date, n As Integer, oRS As DAO.Recordset, sSQL As String
Dim dLowerbreak As Date, dUpperBreak As Date, dDuration As Date
Dim dLowerPrecision As Date, dUpperPrecision As Date
Dim tSQL As String, tRS As DAO.Recordset
Dim tmpStart, tmpEnd, tmpBreak As Date
Dim n As Integer
Dim tmpcnt As Integer
Dim tmpListItem As Date
sSQL = "SELECT * FROM Unavailable WHERE #" & Me.txtAppointDate & "#>= DateFrom AND #" & Me.txtAppointDate & "#<= DateTo AND CounsellorID= " & Me.UserID & ""
Set oRS = CurrentDb.OpenRecordset(sSQL)
If oRS.RecordCount = 0 Then
Else
MsgBox "The Counsellor Selected is unavailable on the date selected, Please try another date"
Me.txtAppointDate.SetFocus
sSQL = ""
Set oRS = Nothing
Exit Sub
End If
'Set oRS = Nothing
'sSQL = ""
tmpStart = DLookup("[Start]", "tblUsers", "UserID =" & Nz([UserID], 0))
tmpEnd = DLookup("[End]", "tblUsers", "UserID =" & Nz([UserID], 0))
tmpBreak = DLookup("[Break]", "tblUsers", "UserID =" & Nz([UserID], 0))
cboTime.RowSourceType = "Value List"
cboTime.RowSource = ""
If IsNull(tmpStart) Then Exit Sub Else i = tmpStart
If Me.NewRecord = True Then
DoCmd.RunCommand acCmdSaveRecord
End If
sSQL = "SELECT appCounsellor, AppDate, StartTime"
sSQL = sSQL & " FROM qrySubformAppointments"
sSQL = sSQL & " WHERE appCounsellor= " & Me.UserID & _
" AND AppDate=#" & Me.txtAppointDate & "#"
Set oRS = CurrentDb.OpenRecordset(sSQL)
dDuration = TimeValue("01:00")
dLowerbreak = tmpBreak - TimeValue("00:25") 'Break is a field
dUpperBreak = tmpBreak + TimeValue("00:25")
tSQL = "SELECT TimeFrom, TimeTo FROM Unavailable WHERE #" & Me.txtAppointDate & "#= DateTime AND CounsellorID= " & Me.UserID & ""
Set tRS = CurrentDb.OpenRecordset(tSQL)
If oRS.RecordCount = 0 Then
Do
If i <= dLowerbreak Or i >= dUpperBreak Then
cboTime.AddItem i
End If
i = i + dDuration
Loop Until i >= tmpEnd
Else
Do
If i <= dLowerbreak Or i >= dUpperBreak Then
dLowerPrecision = i - TimeValue("00:00:05")
dUpperPrecision = i + TimeValue("00:00:05")
oRS.FindFirst "[StartTime] Between #" & dLowerPrecision & "# And #" & dUpperPrecision & "#"
If oRS.NoMatch Then cboTime.AddItem i
End If
i = i + dDuration
Loop Until i >= tmpEnd
End If
oRS.Close
How can I then scroll through my cboTime.RowSource and remove the times that fall between tRS!StartTime and TRS!EndTime. These are all in one hour intervals. Any help whatsoever would be greatly appreciated.