如何在类调度系统中检测vb 6.0和ms访问数据库中的时间冲突

时间:2015-03-01 05:17:11

标签: ms-access vb6

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告诉房间还在被占用。

翻译(?):不要在重复时间内安排冲突。

1 个答案:

答案 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