Calendar Control Source

[MissCLuvr]

I used the following code in a database which is having some minor problems. The user is to type in a date and the change should be throughout the document. This change is not reflected. Also, the user should be able enter a start time, calculate the end time and the start time for the next record should be the time of the end time from the previous record.

I have a visual of this particular form item as well as additional code that is connected to it if someone can help me.

MissCLuvr
***********

Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo Err_Form_BeforeUpdate

If Me.CheckTime.Value = 2 Then Exit Sub
If Me.CheckTime.Value = 1 Then Exit Sub


Dim strSQL As String, qdf As QueryDef
Dim ErrString As String, Count As Integer
Dim rst As Recordset

Set dbs = CurrentDb
Set qdf = dbs.QueryDefs("TimeConflicts")

'Set query Parameters
qdf.Parameters("Forms!BroadcastSchedule!BroadcastDate") _
= [Forms]![BroadcastSchedule]![BroadcastDate]
qdf.Parameters("Forms!BroadcastSchedule!StartTime") _
= [Forms]![BroadcastSchedule]![StartTime]
qdf.Parameters("Forms!BroadcastSchedule!EndTime") _
= [Forms]![BroadcastSchedule]![EndTime]
qdf.Parameters("Forms!BroadcastSchedule!ScheduleID") _
= [Forms]![BroadcastSchedule]![ScheduleID]

Set rst = qdf.OpenRecordset()
rst.MoveLast
Count = rst.RecordCount
rst.MoveFirst
rst.Close

If Count <> 0 Then
ErrString = "Adding this record would cause a time conflict with " & Count & " other record"
If Count <> 1 Then ErrString = ErrString & "s"
ErrString = ErrString & ". Please resolve this conflict and try again!"
MsgBox ErrString, vbOKOnly, "Time Conflict"
Set dbs = Nothing
Cancel = True
Exit Sub
End If

Set dbs = Nothing

Exit Sub
Dim conflict As Integer
conflict = False
DoCmd.OpenQuery "Testing2", acViewNormal, acReadOnly
If Not IsNull(DLookup(BroadcastDate, "Testing2")) Then conflict = True
DoCmd.Close acQuery, "Testing2"

If conflict = True Then MsgBox "PROBLEM"

Err_Form_BeforeUpdate:
If Err.Number = 3021 Then Exit Sub
MsgBox Err.Number & Chr$(13) & Err.Description, , "Error"
Exit Sub

End Sub

 

[Rich]

Might not the PrevRecVal function be of help?