安排宏运行的时间
程序参考:vbaexpress/forum
大家都知道,使用Application对象的OnTime方法可以指定宏运行的时间。现在的问题是,我想让一个宏程序在两个指定的时间区内每隔30分钟执行一次。
例如,运行常量strRunWhat所代表的过程,从上午6点开始到下午11点(23:00)为止,每隔半小时运行一次。
代码如下:
Option Explicit
Option Private Module‘ 在此指定要运行的宏的名称
Const strRunWhat = “<指定过程名>”
Public Sub SetUpMacroSchedule()
‘安排指定的宏运行的时间
Dim i As Long
Dim dblCurrentTimeInLoop As Double ‘停止循环在下午11点,即23点
Dim dblRunWhen() As Double
‘设置i=1开始数组计数器
i = 1
‘开始时间设置为上午6点,即6:00 AM
ReDim dblRunWhen(0)
dblRunWhen(0) = DateSerial(Year(Now()), Month(Now()), Day(Now())) _
+ TimeSerial(6, 0, 0)
Application.OnTime EarliestTime:=dblRunWhen(0), _
Procedure:=strRunWhat, _
Schedule:=True
dblCurrentTimeInLoop = dblRunWhen(0)
‘ 创建循环来建立时间任务数组.
‘ 一直循环直到dblCurrentTimeInLoop变量的时间大于11:00 PM
Do While (TimeSerial(Hour(dblCurrentTimeInLoop), _
Minute(dblCurrentTimeInLoop), 0) < TimeSerial(23, 0, 0))
ReDim Preserve dblRunWhen(i)
‘ 设置下一个dblRunWhen量为下一个半小时
dblRunWhen(i) = dblRunWhen(i - 1) + TimeSerial(0, 30, 0)
Application.OnTime EarliestTime:=dblRunWhen(i), _
Procedure:=strRunWhat, _
Schedule:=True
dblCurrentTimeInLoop = dblRunWhen(i)
‘ 增加i值
i = i + 1
Loop
End Sub

发表评论