How can i detect conflict in time in vb 6.0 and ms

问题:

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

What I want is if there is already a schedule in a room for example ROOM 1 in 7:00 AM - 9:00 AM in monday .then i add new schedule in the same room then in the time 8:00 AM - 9:30 AM the same day also then.the second record will not be save because there is still session in that room (7:00-9:00) it is not over yet so i want that there must be msgbox that tells the room is still occupied.

Translation(?): Don't allow conflicts in scheduling with overlapping time.

回答1:

I use this function to detect conflicts between two date ranges (returns true if conflicting, and false otherwise):

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

See article here

And to put that into perspective, you may use something like:

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