Creating a custom task schedule

[azdjedi]

Hi,



I'm trying to duplicate the Windows Task Scheduler functionality (not to run Windows tasks but rather the actual scheduling capabilities). I have most of it working but there are a few bugs in my code and whenever I fix one bug another is created. I don't think my logic is correct and I'm hoping somebody either has already done this or can help me out. The basic idea is to allow my users to have tasks repeat daily, weekly (Mon-Sun), monthly (1-31, 1st of the month, second Tuesday, last of the month, etc). Thanks for any help...

CREATE TABLE `task_list_repeat` (
  `ID` int(10) unsigned NOT NULL AUTO_INCREMENT,
  `TaskID` int(10) unsigned DEFAULT NULL,
  `TypeID` tinyint(3) unsigned DEFAULT NULL,
  `Sunday` tinyint(1) unsigned DEFAULT '0',
  `Monday` tinyint(1) unsigned DEFAULT '0',
  `Tuesday` tinyint(1) unsigned DEFAULT '0',
  `Wednesday` tinyint(1) unsigned DEFAULT '0',
  `Thursday` tinyint(1) unsigned DEFAULT '0',
  `Friday` tinyint(1) unsigned DEFAULT '0',
  `Frequency` tinyint(3) unsigned DEFAULT NULL,
  `OnDay` tinyint(3) unsigned DEFAULT NULL,
  `AtTime` datetime DEFAULT NULL,
  `Minutes` tinyint(1) unsigned DEFAULT '0',
  PRIMARY KEY (`ID`)
) ENGINE=InnoDB AUTO_INCREMENT=145 DEFAULT CHARSET=utf8

Public Function GetNextOccurance(TaskID As Long, Optional LastRun As Date) As Date
    On Error Resume Next
    
    Dim rs As New ADODB.Recordset
    Dim datNext As Date, datRepeat As Date
    Dim iDay As Integer
    
    If LastRun = #12:00:00 AM# Then LastRun = date
    LastRun = DateValue(LastRun)
    
    GetNextOccurance = #1/1/3000# 'We should have a new system in place by then :P
    
    'Daily
    With rs
        Call PassThrough("SELECT * FROM task_list_repeat WHERE TypeID=0 AND TaskID=" & TaskID & " ORDER BY AtTime DESC", True)
        
        .Open "SELECT * FROM [Pass Through]", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
            
        Do Until .EOF
            'No Time specified so always use next Frequency
            If TimeValue(!AtTime) = #12:00:00 AM# Then
                datRepeat = DateAdd("d", !Frequency, LastRun)
            Else
                'If the run time is in the past set it for the next frequency, else it's today
                datRepeat = IIf(TimeValue(!AtTime) < Time, DateAdd("d", !Frequency, LastRun), date)
            End If
            
            'Future time
            If Nz(TimeValue(!AtTime), #5:30:00 AM#) > Time Then
                GetNextOccurance = datRepeat + Nz(TimeValue(!AtTime), #5:30:00 AM#)
            Else 'Past time but future date
                If GetNextOccurance > datRepeat + Nz(TimeValue(!AtTime), #5:30:00 AM#) Then GetNextOccurance = datRepeat + Nz(TimeValue(!AtTime), #5:30:00 AM#)
            End If
            
            .MoveNext
        Loop
    
        .Close
    End With
    
    With rs
        .Open "SELECT * FROM task_list_repeat WHERE TypeID<>0 AND TaskID=" & TaskID, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
        
        'Loop through each Repeat and return the soonest one
        Do Until .EOF
            Select Case !TypeID
                Case 1 'Weekly
                    If Weekday(LastRun) = vbSaturday Then
                        datRepeat = LastRun + 1 'Get start of next week
                    Else
                        datRepeat = LastRun - Weekday(LastRun) + 1 'Get start of week
                    End If
                    
                    'Check each day to see if it's scheduled
                    For iDay = 1 To 7
                        If .Fields(Format(datRepeat + iDay, "dddd")) And datRepeat + iDay > LastRun Then
                            datRepeat = datRepeat + iDay
                            GoTo DateFound
                        End If
                    Next
                    
************** 
The below comments was what I originally had but I switched it out for the above 6 lines. The main problem I'm getting is for tasks that are run daily multiple times; after the 7AM task runs it goes to tomorrow instead of reporting back the 9AM task on the same day.
************** 



'                    iDay = 0
'                    If !Friday Then iDay = vbFriday
'                    If !Thursday Then iDay = vbThursday
'                    If !Wednesday Then iDay = vbWednesday
'                    If !Tuesday Then iDay = vbTuesday
'                    If !Monday Then iDay = vbMonday
'                    If !Sunday Then iDay = vbSunday
'
'                    'Ensure it happens on the chosen day
'                    If iDay Then
'                        Do Until Weekday(datRepeat) = iDay
'                            datRepeat = datRepeat + 1
'                        Loop
'                        GoTo DateFound
'                    End If
                    
                Case 2 'Monthly
                    
                    'Last day
                    If !OnDay = 32 Then
                        If Day(LastRun) <= 7 Then 'They probably just missed the run-date, so make the next one include this month
                            datRepeat = DateSerial(Year(LastRun), Month(LastRun) + !Frequency, 1) - 1
                        Else
                            datRepeat = DateSerial(Year(LastRun), Month(LastRun) + !Frequency + 1, 1) - 1
                        End If
                    Else 'Specific day
                        If !Sunday = False And !Monday = False And !Tuesday = False And !Wednesday = False And !Thursday = False And !Friday = False Then
                            datRepeat = DateSerial(Year(LastRun), Month(LastRun), !OnDay) 'Get the date it should have been run for this month (in case they missed it)
                            datRepeat = DateAdd("m", !Frequency, datRepeat)
                        Else
                            'Start from the 1st of the month and count to the proper date
                            datRepeat = DateSerial(Year(LastRun), Month(LastRun) + !Frequency, 1)
                            
                            If !OnDay > 1 Then datRepeat = datRepeat + (7 * (!OnDay - 1))
                                
                            iDay = 0
                            If !Friday Then iDay = vbFriday
                            If !Thursday Then iDay = vbThursday
                            If !Wednesday Then iDay = vbWednesday
                            If !Tuesday Then iDay = vbTuesday
                            If !Monday Then iDay = vbMonday
                            If !Sunday Then iDay = vbSunday
                            
                            'Ensure it happens on the chosen day
                            If iDay Then
                                Do Until Weekday(datRepeat) = iDay
                                    datRepeat = datRepeat + 1
                                Loop
                                GoTo DateFound
                            End If
                                End If
                            End If
                Case 3 'Minutes
                    datRepeat = DateAdd("n", !Frequency, DLookup("DateCompleted", "task_list_log", "ID=" & TaskID))
                    
                    'Missed, so force it to now
                    If datRepeat < Now Then datRepeat = Now
                    
                    'Cycle to next day
                    If TimeValue(datRepeat) > DATE_LAST_ATTEMPT_NIGHT Then datRepeat = LastRun + DATE_FIRST_ATTEMPT
                End Select
            
DateFound:
            If datRepeat + Nz(TimeValue(!AtTime), #5:30:00 AM#) < GetNextOccurance Then GetNextOccurance = datRepeat + Nz(TimeValue(!AtTime), #5:30:00 AM#)
            
            .MoveNext
        Loop
        
        .Close
    End With
    
    If TimeValue(GetNextOccurance) = #12:00:00 AM# Then GetNextOccurance = GetNextOccurance + DATE_FIRST_ATTEMPT
        
    Set rs = Nothing
End Function

[ipisors]

"anyone done it before" ..

This may give you some ideas, thoughts, or just general inspiration. Or maybe not.

http://www.utteraccess.com/forum/ind...post&p=2379511

[azdjedi]

Thanks for the reply. The thread is the same idea but it doesn't actually address HOW to create the next schedule. The SQL looks like it's just grabbing the next one from a pre-deteremined table of schedules.

[ipisors]

Thanks for the reply. The thread is the same idea but it doesn't actually address HOW to create the next schedule. The SQL looks like it's just grabbing the next one from a pre-deteremined table of schedules.

... Exactly. So create a table of schedules with Report name, vba Sub name, Next scheduled due, Interval (days, number datatype).

[azdjedi]

I feel ya

Thanks