Function RoomInUse() As Boolean
Dim room As String
Dim day As String
Dim tmein As Date
Dim tmeout As Date
Dim mond As String
Set rs = New ADODB.Recordset
With rs
mond = "select * from tblsched where room Like '" & Combo2.Text & "%' and day like '" & Combo3.Text & "' and (tmein <= #" & Combo1 & "# And " & _
"tmeout >= #" & Combo1 & "#) Or (#" & Combo1 & "#" & _
"<= tmein And tmeout < #" & Combo8 & "#) Or (#" & _
Combo1 & "# <= tmein And tmein < #" & Combo8 & "#)) " '"
.Open mond, con, 3, 3
End With
If rs.RecordCount >= 1 Then
RoomInUse = True
Else
RoomInUse = False
End If
End Function
我想要的是,如果在一个房间里已经有一个时间表,例如在星期一上午7:00到9:00的房间1,那么我会在同一个房间添加新的时间表,然后在上午8:00 - 那天也是同一天上午9:30。第二条记录将不会保存,因为那个房间还有会话(7:00-9:00)它还没有结束所以我想要一定有msgbox告诉房间还在被占用。
翻译(?):不要在重复时间内安排冲突。
答案 0 :(得分:0)
我使用此函数来检测两个日期范围之间的冲突(如果冲突则返回true,否则返回false):
Public Function interlapDate(start1 As Date, end1 As Date, start2 As Date, end2 As Date) As Boolean
'Credits to Martin Fowler's Range Pattern Algorithm
interlapDate = end1 >= start2 And end2 >= start1
End Function
参见文章here
为了更好地理解这一点,你可以使用类似的东西:
Private Function roomIsAvailable() as Boolean
Dim strQuery as string
Dim rs as New ADODB.Recordset
Dim newTimeIn as Date
Dim newTimeOut as Date
'Initialize
roomIsAvailable = True
'Assuming from ur sample code that combo1 and combo2 are the user-input range
newTimeIn = TimeValue(CDate(combo1))
newTimeOut = TimeValue(CDate(combo2))
strQuery = "SELECT time_start, time_end" & _
" FROM tbl_sched" & _
" WHERE room LIKE '" & Combo2.Text & "'" & _
" AND day LIKE '" & Combo3.Text & "'"
rs.open strQuery, con, 3, 3
Do While Not rs.EOF
'Compare new range to each range saved in database
If interlapDate(rs!time_start, rs!time_end, newTimeIn, newTimeOut) Then
GoTo conflictFound
Exit Do
End If
rs.moveNext
Loop
Exit Function
conflictFound:
Msgbox "Overlap found!",vbExclamation
roomIsAvailable = False
End Function