Problem with timeslot generating code

David b

Registered User.
Local time
Today, 18:43
Joined
Mar 2, 2003
Messages
102
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
 
That`s unusual on here. No replies.
I will have to try comp.databases.msaccess. <vbg>
david b
 
maybe posting indented readable code would help....
 
But then again its YOUR code.

Most people believe its "good practice to INDENT code
Code:
If .... then
    More code
else
    Some more coding here
end if

like that you know....

Also try using
Code:
 and tags to preserve it.

I find your huge code pretty unreadable, exept for if i put in the time to indent it, which i dont feel much for at the moment.....

Regards
 

Users who are viewing this thread

Back
Top Bottom