I have a module. It is supposed to get a list of avail Rooms (it does this). Then take a request, compare that request to a schedule. Looping thru each room in the available list & checking the schedule to see if a record exists for that room, date, & hour.
Problem is, even my debug.print statements don't seem to come out where they make sense.
My code is:
Private Sub Store_Req_Pending_Click()
Dim x As Integer, y As Integer, L As Integer, blnAvail(1 To 3) As Boolean
Dim dbs As Database
Dim rstAvailRm As ADODB.Recordset
Set rstAvailRm = New ADODB.Recordset
Dim MkRmList As String
Dim rstSchedHrs As ADODB.Recordset
Dim dtEndDay As Date, intEndTime As Integer
Dim intHourVar As Integer, dtDayVar As Date
Debug.Print "Len(Nz([Forms]!frmSchedReq!UserID)) " & Len(Nz([Forms]!frmSchedReq!UserID, ""))
y = 0
Debug.Print "Len(Nz([Forms]!frmSchedReq!cboRmType, "")) " & Len(Nz([Forms]!frmSchedReq!cboRmType, ""))
If Len(Nz([Forms]!frmSchedReq!cboRmType, "")) > 0 Then
'Check to see if information is entered in all available request fields
For x = 1 To 10
If Len(Nz(Me("cboStartHour" & CStr(x)), "")) <> 0 Then
y = y + 1
End If
Next x
Debug.Print "y = " & y & "----"
x = 1
' Re-add these on completion of program 'turn off warnings
' 'DoCmd.SetWarnings False
' Delete unnecessary with the make
'RmSQL = "Select * From tblRmList"
'Delete Existing Data in tblRmList
' DoCmd.RunSQL ("Delete * From RmList")
MkRmList = "SELECT DISTINCT RoomName.RmKey, " & _
"RoomName.RoomName INTO tblRmList FROM [Room Type] INNER JOIN RoomName ON " & _
"[Room Type].RmTypeId = RoomName.RoomType " & _
"Where [Room Type].RmTypeId=" & [Forms]!frmSchedReq!cboRmType
DoCmd.RunSQL MkRmList
' These 2 done with the MkRmList above
'Populate tblRmList with matching Room data
' DoCmd.OpenQuery ("qryAppendToRoomAvail")
'open recordsets for processing
Set dbs = CodeDb
'Set rstSchedHrs = dbs.OpenRecordset("tblScheduleHours", dbOpenDynaset)
Set rstSchedHrs = New ADODB.Recordset
rstSchedHrs.CursorLocation = adUseClient
rstSchedHrs.Open "tblScheduleHours", CurrentProject.Connection, adOpenStatic, adLockOptimistic
' Set rstAvailRm = dbs.OpenRecordset("tblRmList")
Set rstAvailRm = New ADODB.Recordset
rstAvailRm.CursorLocation = adUseClient
rstAvailRm.Open "tblRmList", CurrentProject.Connection, adOpenStatic, adLockOptimistic
'Sort "ON RmKey", rstavailrm
rstAvailRm.Sort = "RmKey ASC"
'Loop though all rooms that match requested type and check for availability
With rstAvailRm
If .RecordCount > 0 Then
.MoveFirst
Debug.Print "MoveFirst rstAvailRm!RmKey--" & rstAvailRm!RmKey
Debug.Print "MoveFirst AvailRm!RoomName--" & rstAvailRm!RoomName
Do While Not .EOF
Debug.Print "rstrstAvailRm!RmKey--" & rstAvailRm!RmKey
Debug.Print "rstrstAvailRm!RoomName--" & rstAvailRm!RoomName
'Check the 10 possible requests
For x = 1 To y
dtDayVar = Me("dtStartDate" & CStr(x))
dtEndDay = Me("dtEndDate" & CStr(x))
intHourVar = Me("cboStartHour" & CStr(x))
intEndTime = Me("cboEndHour" & CStr(x))
Do While dtDayVar < DateAdd("d", 1, dtEndDay)
'Do While intHourVar < intEndTime
' have to use a for loop so can loop 2400-0000
For L = intHourVar To intEndTime Step 100
Debug.Print "intHourVar = " & intHourVar & "--"
If intHourVar = 2400 Then
intHourVar = 0
dtDayVar = DateAdd("d", 1, dtDayVar)
End If
With rstSchedHrs
If .RecordCount > 0 Then
.MoveFirst
Do While Not .EOF
'.Find "RoomID = " & rstAvailRm!RmKey & " And DayInUse = #" & dtDayVar
' & "# And HourInUse =" & intHourVar
Debug.Print "rstSchedHrs!RoomID =" & rstSchedHrs!RoomID
Debug.Print "rstAvailRm!RmKey =" & rstAvailRm!RmKey
Debug.Print "rstSchedHrs!DayInUse =" & rstSchedHrs!DayInUse
Debug.Print "dtDayVar = " & dtDayVar & " rstSchedHrs!HourInUse = " & rstSchedHrs!HourInUse _
& "intHourVar = " & intHourVar
If ((rstSchedHrs!RoomID = rstAvailRm!RmKey) And _
(rstSchedHrs!DayInUse = dtDayVar) And (rstSchedHrs!HourInUse = intHourVar)) Then
' record conflict
Debug.Print "Conflict -Room " & rstAvailRm!RmKey & " " & dtDayVar & " " & intHourVar
'blnAvail(x) = False
'GoTo NextXHere
' If Not .NoMatch Then
' If Not .EOF Then
Else
Debug.Print "RoomID =" & rstAvailRm!RmKey & " record; doesn 't match AvailRm"
' Debug.Print "No record found in schedule file, add to schedule."
End If
If Not .EOF Then
.MoveNext
Else
End If
Loop
End If
End With
intHourVar = intHourVar + 100
Next L
If (Me("cboStartHour" & CStr(x)) > intEndTime) Then
dtDayVar = DateAdd("d", -1, dtDayVar)
End If
' Loop
dtDayVar = DateAdd("d", 1, dtDayVar)
intHourVar = Me("cboStartHour" & CStr(x))
Loop
NextXHere:
Next x
'move to the next record in table with classrooms
.MoveNext
Loop
End If
End With
End If
errExit:
Set dbs = Nothing
Set rstAvailRm = Nothing
Set rstSchedHrs = Nothing
Exit Sub
errHandler:
MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, "Error In Room Request Process"
Resume errExit
End Sub
The input was startdate 3/1/2004 startHour 1300 end date 3/20/2004 end hour 2100
some of output:
rstSchedHrs!RoomID =2
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/1/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 1400intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =2
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/1/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 1500intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =2
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/1/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 1600intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =2
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/1/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 1800intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =2
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/1/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 1900intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =2
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/1/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 2000intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =3
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/1/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 800intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =3
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/1/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 900intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =3
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/10/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 1100intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =3
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/10/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 1200intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =3
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/10/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 1300intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
I first expected to see the debug.prints for:
Len(Nz([Forms]!frmSchedReq!UserID))
Len(Nz([Forms]!frmSchedReq!cboRmType, ""))
& Debug.Print "y = " & y & "----"
but none of these ever showed up.
(Is there a limit to the lines of print that will show up in the immediate window?)
Besides that the RoomID I expected to start at 1, all I see is 7
Is there something I'm missing?
Problem is, even my debug.print statements don't seem to come out where they make sense.
My code is:
Private Sub Store_Req_Pending_Click()
Dim x As Integer, y As Integer, L As Integer, blnAvail(1 To 3) As Boolean
Dim dbs As Database
Dim rstAvailRm As ADODB.Recordset
Set rstAvailRm = New ADODB.Recordset
Dim MkRmList As String
Dim rstSchedHrs As ADODB.Recordset
Dim dtEndDay As Date, intEndTime As Integer
Dim intHourVar As Integer, dtDayVar As Date
Debug.Print "Len(Nz([Forms]!frmSchedReq!UserID)) " & Len(Nz([Forms]!frmSchedReq!UserID, ""))
y = 0
Debug.Print "Len(Nz([Forms]!frmSchedReq!cboRmType, "")) " & Len(Nz([Forms]!frmSchedReq!cboRmType, ""))
If Len(Nz([Forms]!frmSchedReq!cboRmType, "")) > 0 Then
'Check to see if information is entered in all available request fields
For x = 1 To 10
If Len(Nz(Me("cboStartHour" & CStr(x)), "")) <> 0 Then
y = y + 1
End If
Next x
Debug.Print "y = " & y & "----"
x = 1
' Re-add these on completion of program 'turn off warnings
' 'DoCmd.SetWarnings False
' Delete unnecessary with the make
'RmSQL = "Select * From tblRmList"
'Delete Existing Data in tblRmList
' DoCmd.RunSQL ("Delete * From RmList")
MkRmList = "SELECT DISTINCT RoomName.RmKey, " & _
"RoomName.RoomName INTO tblRmList FROM [Room Type] INNER JOIN RoomName ON " & _
"[Room Type].RmTypeId = RoomName.RoomType " & _
"Where [Room Type].RmTypeId=" & [Forms]!frmSchedReq!cboRmType
DoCmd.RunSQL MkRmList
' These 2 done with the MkRmList above
'Populate tblRmList with matching Room data
' DoCmd.OpenQuery ("qryAppendToRoomAvail")
'open recordsets for processing
Set dbs = CodeDb
'Set rstSchedHrs = dbs.OpenRecordset("tblScheduleHours", dbOpenDynaset)
Set rstSchedHrs = New ADODB.Recordset
rstSchedHrs.CursorLocation = adUseClient
rstSchedHrs.Open "tblScheduleHours", CurrentProject.Connection, adOpenStatic, adLockOptimistic
' Set rstAvailRm = dbs.OpenRecordset("tblRmList")
Set rstAvailRm = New ADODB.Recordset
rstAvailRm.CursorLocation = adUseClient
rstAvailRm.Open "tblRmList", CurrentProject.Connection, adOpenStatic, adLockOptimistic
'Sort "ON RmKey", rstavailrm
rstAvailRm.Sort = "RmKey ASC"
'Loop though all rooms that match requested type and check for availability
With rstAvailRm
If .RecordCount > 0 Then
.MoveFirst
Debug.Print "MoveFirst rstAvailRm!RmKey--" & rstAvailRm!RmKey
Debug.Print "MoveFirst AvailRm!RoomName--" & rstAvailRm!RoomName
Do While Not .EOF
Debug.Print "rstrstAvailRm!RmKey--" & rstAvailRm!RmKey
Debug.Print "rstrstAvailRm!RoomName--" & rstAvailRm!RoomName
'Check the 10 possible requests
For x = 1 To y
dtDayVar = Me("dtStartDate" & CStr(x))
dtEndDay = Me("dtEndDate" & CStr(x))
intHourVar = Me("cboStartHour" & CStr(x))
intEndTime = Me("cboEndHour" & CStr(x))
Do While dtDayVar < DateAdd("d", 1, dtEndDay)
'Do While intHourVar < intEndTime
' have to use a for loop so can loop 2400-0000
For L = intHourVar To intEndTime Step 100
Debug.Print "intHourVar = " & intHourVar & "--"
If intHourVar = 2400 Then
intHourVar = 0
dtDayVar = DateAdd("d", 1, dtDayVar)
End If
With rstSchedHrs
If .RecordCount > 0 Then
.MoveFirst
Do While Not .EOF
'.Find "RoomID = " & rstAvailRm!RmKey & " And DayInUse = #" & dtDayVar
' & "# And HourInUse =" & intHourVar
Debug.Print "rstSchedHrs!RoomID =" & rstSchedHrs!RoomID
Debug.Print "rstAvailRm!RmKey =" & rstAvailRm!RmKey
Debug.Print "rstSchedHrs!DayInUse =" & rstSchedHrs!DayInUse
Debug.Print "dtDayVar = " & dtDayVar & " rstSchedHrs!HourInUse = " & rstSchedHrs!HourInUse _
& "intHourVar = " & intHourVar
If ((rstSchedHrs!RoomID = rstAvailRm!RmKey) And _
(rstSchedHrs!DayInUse = dtDayVar) And (rstSchedHrs!HourInUse = intHourVar)) Then
' record conflict
Debug.Print "Conflict -Room " & rstAvailRm!RmKey & " " & dtDayVar & " " & intHourVar
'blnAvail(x) = False
'GoTo NextXHere
' If Not .NoMatch Then
' If Not .EOF Then
Else
Debug.Print "RoomID =" & rstAvailRm!RmKey & " record; doesn 't match AvailRm"
' Debug.Print "No record found in schedule file, add to schedule."
End If
If Not .EOF Then
.MoveNext
Else
End If
Loop
End If
End With
intHourVar = intHourVar + 100
Next L
If (Me("cboStartHour" & CStr(x)) > intEndTime) Then
dtDayVar = DateAdd("d", -1, dtDayVar)
End If
' Loop
dtDayVar = DateAdd("d", 1, dtDayVar)
intHourVar = Me("cboStartHour" & CStr(x))
Loop
NextXHere:
Next x
'move to the next record in table with classrooms
.MoveNext
Loop
End If
End With
End If
errExit:
Set dbs = Nothing
Set rstAvailRm = Nothing
Set rstSchedHrs = Nothing
Exit Sub
errHandler:
MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, "Error In Room Request Process"
Resume errExit
End Sub
The input was startdate 3/1/2004 startHour 1300 end date 3/20/2004 end hour 2100
some of output:
rstSchedHrs!RoomID =2
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/1/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 1400intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =2
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/1/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 1500intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =2
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/1/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 1600intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =2
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/1/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 1800intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =2
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/1/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 1900intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =2
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/1/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 2000intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =3
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/1/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 800intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =3
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/1/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 900intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =3
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/10/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 1100intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =3
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/10/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 1200intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
rstSchedHrs!RoomID =3
rstAvailRm!RmKey =7
rstSchedHrs!DayInUse =3/10/2004
dtDayVar = 3/20/2004 rstSchedHrs!HourInUse = 1300intHourVar = 2000
RoomID =7 record; doesn 't match AvailRm
I first expected to see the debug.prints for:
Len(Nz([Forms]!frmSchedReq!UserID))
Len(Nz([Forms]!frmSchedReq!cboRmType, ""))
& Debug.Print "y = " & y & "----"
but none of these ever showed up.
(Is there a limit to the lines of print that will show up in the immediate window?)
Besides that the RoomID I expected to start at 1, all I see is 7
Is there something I'm missing?
