There have been several requests from developers to be able to run a subroutine on a periodic basis between specific times each day. Start with the data elements we need to address this issue are:
StartTime: the time-of-day at or after which the
subroutine will be run.
EndTime: the time-of-day before or at which the subroutine will be run.
Duration: the time when the subroutine will be run. The subroutine will
be run at each Duration interval starting with the StartTime.
SubName: the name of the subroutine that is to be run.
With these data elements in place, we can address the algorithm's logic.
If the code is first executed before the StartTime, it
should simply reschedule itself for the StartTime.
If the code is first executed after the EndTime, it should reschedule itself for
the StartTime the next day.
If the code is executed for the first time between the StartTime and EndTime,
it should schedule itself for execution for the next time that is an exact
multiple of Duration past the StartTime.
If none of the above conditions are satisfied, it means the code is being run
at a scheduled time. Consequently, it will run the subroutine specified by SubName and then schedule itself for execution at the current scheduled time +
Duration.
The code in Code Sample 2 should be treated as a 'black box' in that as long as the reader is satisfied with the above characteristics, the code needs no modification. Put it in a standard module and don't add any other code to that module. Add code in some other module to call the runSubOnDailySchedule subroutine with the four required parameters as in the example in Code Sample 1.
Option Explicit
Sub getGoing()
runSubOnDailySchedule TimeSerial(8, 0, 0), _
TimeSerial(17, 0, 0), TimeSerial(0, 0, 30), "showTime"
End Sub
Sub showTime()
MsgBox Now
End Sub
Option Explicit
Option Private Module
'For all practical purposes, treat this module as a 'black
box.' You _
should not need to
make any changes to it.
'The purpose of this module is to execute a procedure on a
periodic basis _
each day between specific times. _
Call the
runSubOnDailySchedule with the following parameters: _
StartTime is the time of day at or after which the specified _
subroutine will be run _
EndTime is the time of day at or before which the specified
subroutine _
will be run _
Duration is when the subroutine will be run.
It will be run starting _
at StartTime and then every Duration interval. _
SubName is the name of the subroutine to be called.
It must be _
declared with no arguments. _
An use example: To call the showTime subroutine every 15 seconds _
between 10:09 PM and 10:10 PM each day, use _
runSubOnDailySchedule TimeSerial(22, 9, 0), _
TimeSerial(22, 10, 0), TimeSerial(0, 0, 15), "showTime"
'An assumption that the code in this module makes is that
the routine _
identified by
SubName (or gSubName) takes less time to execute than _
the Duration (or
gDuration)
Dim NextTime As Date, _
gStartTime As Date, gEndTime As Date, gDuration As Date, _
gSubName As String
Function Ceiling(ByVal X As Double) As Long
Ceiling = -Int(-X)
End Function
Sub scheduleTask(ByVal forWhen As Date, ByVal TaskName As String)
NextTime = forWhen
Application.OnTime NextTime, TaskName
End Sub
Sub actualScheduler()
If Time < gStartTime Then
scheduleTask gStartTime, "actualScheduler"
ElseIf Time > gEndTime Then
scheduleTask gStartTime + Date + 1, "actualScheduler"
ElseIf NextTime <> 0 Then
Application.Run gSubName
scheduleTask NextTime - IIf(NextTime > 1, 1, 0) + gDuration, _
"actualScheduler"
Else
scheduleTask gStartTime _
+ Ceiling((Time - gStartTime) / gDuration) * gDuration, _
"actualScheduler"
End If
End Sub
Public Sub runSubOnDailySchedule( _
ByVal StartTime As Date, ByVal EndTime As Date, _
ByVal Duration As Date, ByVal SubName As String)
If StartTime > 1 Then StartTime = StartTime - Int(StartTime)
If EndTime > 1 Then EndTime = EndTime - Int(EndTime)
If Duration > (EndTime - StartTime) Then _
MsgBox "Duration cannot be longer than daily schedule": Exit Sub
gStartTime = StartTime
gEndTime = EndTime
gDuration = Duration
gSubName = SubName
actualScheduler
End Sub
