The code below generates timeslots. it works fine apart from ignoring the start time. That is it always generates the 1st time as 1am not the time the user has entered on the form.
Any thoughts on what is wrong ?
Tia
David b
Private Sub OK_Click()
On Error GoTo OK_Click_Error
Dim dbl30Minutes As Double
Dim dblTimeIncr As Double
Dim dblCurrentTime As Double
Dim dblBeginTime As Double
Dim dblEndTime As Double
Dim intCurrentTime As Integer 'used to test times in aTimeSlots array
Dim intBeginTime As Integer
Dim intEndTime As Integer
Dim dblCurrentDate As Date
Dim dblBeginDate As Date
Dim dblEndDate As Date
Dim fSkipDay As Boolean 'flags used to track various states
Dim fSkipTime As Boolean
Dim fPreviousRecs As Boolean
Dim lngResourceID As Long
Dim lngScheduleId As Long
Dim strCriteria As String
If IsNull(Me![BeginTime]) Or IsNull(Me![EndTime]) Then
MsgBox "You must specify beginning and ending times in order to generate a schedule."
DoCmd.GoToControl "BeginTime"
Exit Sub
End If
If Me![BeginTime].ListIndex >= Me![EndTime].ListIndex Then
MsgBox "End time must be greater than begin time."
DoCmd.GoToControl "BeginTime"
Exit Sub
End If
If Me![BeginDate] > Me![EndDate] Then
MsgBox "End date cannot be less than begin date."
DoCmd.GoToControl "BeginTime"
Exit Sub
End If
DoCmd.Hourglass True
lngResourceID = Me![ResourceID]
dbl30Minutes = TimeSerial(2, 30, 0) - TimeSerial(2, 0, 0)
dblBeginTime = Me![BeginTime].ListIndex * dbl30Minutes
dblEndTime = Me![EndTime].ListIndex * dbl30Minutes
dblTimeIncr = dbl30Minutes * Me![TimeIncrement].Column(0) 'column 0 contains the number of 30 minute time segments in the time increment
Set dbs = CurrentDb()
Set rstSchedule = dbs.OpenRecordset("Schedule", dbOpenDynaset)
Set rstScheduleDtl = dbs.OpenRecordset("Schedule Details")
dblBeginDate = Me![BeginDate]
dblEndDate = Me![EndDate]
dblCurrentDate = dblBeginDate
While dblCurrentDate <= dblEndDate
If (Not SkipThisDay(DatePart("w", dblCurrentDate))) Then
rstSchedule.FindFirst "[ResourceID]=" & Me![ResourceID] & " AND [ScheduleDate]= #" & Format(dblCurrentDate, "m-d-yy") & "#"
If rstSchedule.NoMatch Then
rstSchedule.AddNew
rstSchedule![ResourceID] = lngResourceID
rstSchedule![ScheduleDate] = dblCurrentDate
lngScheduleId = rstSchedule![ScheduleID]
rstSchedule.Update
fPreviousRecs = False
Else
lngScheduleId = rstSchedule![ScheduleID]
End If
fPreviousRecs = isPreviousRecs(lngResourceID, dblCurrentDate) 'sets flag and loads atimeSlots array if applicable
dblCurrentTime = dblBeginTime
intCurrentTime = Me![BeginTime].ListIndex + 48
intBeginTime = intCurrentTime
intEndTime = intBeginTime + Me![TimeIncrement].Column(0)
Do
fSkipTime = False
If fPreviousRecs Then
If isOverlap(intBeginTime, intEndTime) Then
fSkipTime = True
End If
intBeginTime = intBeginTime + Me![TimeIncrement].Column(0)
intEndTime = intBeginTime + Me![TimeIncrement].Column(0)
End If
If fSkipTime = False Then
rstScheduleDtl.AddNew
rstScheduleDtl![ScheduleID] = lngScheduleId
rstScheduleDtl![ScheduleStartTime] = Format(dblCurrentTime, "hh:mm AMPM")
rstScheduleDtl![ScheduleEndTime] = Format(dblCurrentTime + dblTimeIncr, "hh:mm AMPM")
rstScheduleDtl.Update
End If
dblCurrentTime = dblCurrentTime + dblTimeIncr
Loop Until (dblCurrentTime + dblTimeIncr) > (dblEndTime + 0.01) 'the .01 adds a few minutes to deal with small number precision issues
End If
dblCurrentDate = dblCurrentDate + 1
Wend
DoCmd.Close acForm, "Generate"
rstSchedule.Close
rstScheduleDtl.Close
dbs.Close
OK_Click_Exit:
DoCmd.Hourglass False
Exit Sub
OK_Click_Error:
MsgBox Err.Description
Resume OK_Click_Exit
End Sub
Any thoughts on what is wrong ?
Tia
David b
Private Sub OK_Click()
On Error GoTo OK_Click_Error
Dim dbl30Minutes As Double
Dim dblTimeIncr As Double
Dim dblCurrentTime As Double
Dim dblBeginTime As Double
Dim dblEndTime As Double
Dim intCurrentTime As Integer 'used to test times in aTimeSlots array
Dim intBeginTime As Integer
Dim intEndTime As Integer
Dim dblCurrentDate As Date
Dim dblBeginDate As Date
Dim dblEndDate As Date
Dim fSkipDay As Boolean 'flags used to track various states
Dim fSkipTime As Boolean
Dim fPreviousRecs As Boolean
Dim lngResourceID As Long
Dim lngScheduleId As Long
Dim strCriteria As String
If IsNull(Me![BeginTime]) Or IsNull(Me![EndTime]) Then
MsgBox "You must specify beginning and ending times in order to generate a schedule."
DoCmd.GoToControl "BeginTime"
Exit Sub
End If
If Me![BeginTime].ListIndex >= Me![EndTime].ListIndex Then
MsgBox "End time must be greater than begin time."
DoCmd.GoToControl "BeginTime"
Exit Sub
End If
If Me![BeginDate] > Me![EndDate] Then
MsgBox "End date cannot be less than begin date."
DoCmd.GoToControl "BeginTime"
Exit Sub
End If
DoCmd.Hourglass True
lngResourceID = Me![ResourceID]
dbl30Minutes = TimeSerial(2, 30, 0) - TimeSerial(2, 0, 0)
dblBeginTime = Me![BeginTime].ListIndex * dbl30Minutes
dblEndTime = Me![EndTime].ListIndex * dbl30Minutes
dblTimeIncr = dbl30Minutes * Me![TimeIncrement].Column(0) 'column 0 contains the number of 30 minute time segments in the time increment
Set dbs = CurrentDb()
Set rstSchedule = dbs.OpenRecordset("Schedule", dbOpenDynaset)
Set rstScheduleDtl = dbs.OpenRecordset("Schedule Details")
dblBeginDate = Me![BeginDate]
dblEndDate = Me![EndDate]
dblCurrentDate = dblBeginDate
While dblCurrentDate <= dblEndDate
If (Not SkipThisDay(DatePart("w", dblCurrentDate))) Then
rstSchedule.FindFirst "[ResourceID]=" & Me![ResourceID] & " AND [ScheduleDate]= #" & Format(dblCurrentDate, "m-d-yy") & "#"
If rstSchedule.NoMatch Then
rstSchedule.AddNew
rstSchedule![ResourceID] = lngResourceID
rstSchedule![ScheduleDate] = dblCurrentDate
lngScheduleId = rstSchedule![ScheduleID]
rstSchedule.Update
fPreviousRecs = False
Else
lngScheduleId = rstSchedule![ScheduleID]
End If
fPreviousRecs = isPreviousRecs(lngResourceID, dblCurrentDate) 'sets flag and loads atimeSlots array if applicable
dblCurrentTime = dblBeginTime
intCurrentTime = Me![BeginTime].ListIndex + 48
intBeginTime = intCurrentTime
intEndTime = intBeginTime + Me![TimeIncrement].Column(0)
Do
fSkipTime = False
If fPreviousRecs Then
If isOverlap(intBeginTime, intEndTime) Then
fSkipTime = True
End If
intBeginTime = intBeginTime + Me![TimeIncrement].Column(0)
intEndTime = intBeginTime + Me![TimeIncrement].Column(0)
End If
If fSkipTime = False Then
rstScheduleDtl.AddNew
rstScheduleDtl![ScheduleID] = lngScheduleId
rstScheduleDtl![ScheduleStartTime] = Format(dblCurrentTime, "hh:mm AMPM")
rstScheduleDtl![ScheduleEndTime] = Format(dblCurrentTime + dblTimeIncr, "hh:mm AMPM")
rstScheduleDtl.Update
End If
dblCurrentTime = dblCurrentTime + dblTimeIncr
Loop Until (dblCurrentTime + dblTimeIncr) > (dblEndTime + 0.01) 'the .01 adds a few minutes to deal with small number precision issues
End If
dblCurrentDate = dblCurrentDate + 1
Wend
DoCmd.Close acForm, "Generate"
rstSchedule.Close
rstScheduleDtl.Close
dbs.Close
OK_Click_Exit:
DoCmd.Hourglass False
Exit Sub
OK_Click_Error:
MsgBox Err.Description
Resume OK_Click_Exit
End Sub