如何用VBA实现Excel宏每日零点和7点自动重复执行

问题根源 #

你当前的代码仅在工作簿打开时注册了一次定时任务，Application.OnTime本身仅支持单次触发，任务执行完成后不会自动重复调度。

完整调整代码 #

所有代码均需放在ThisWorkbook模块中：

1. 顶部先声明模块级变量（用于存储定时任务时间，方便后续取消调度） #

' 存储两个定时任务的触发时间
Private nextRunTime0 As Date
Private nextRunTime7 As Date

2. 修改Workbook_Open事件逻辑 #

Private Sub Workbook_Open()
    ' 首次调度时判断时间，避免打开文件时已经过了触发时间导致立刻执行
    If Time < TimeValue("00:00:00") Then
        nextRunTime0 = Date + TimeValue("00:00:00")
    Else
        nextRunTime0 = Date + 1 + TimeValue("00:00:00")
    End If
    
    If Time < TimeValue("07:00:00") Then
        nextRunTime7 = Date + TimeValue("07:00:00")
    Else
        nextRunTime7 = Date + 1 + TimeValue("07:00:00")
    End If
    
    ' 注册首次定时任务
    Application.OnTime nextRunTime0, "RefreshAllDataConn"
    Application.OnTime nextRunTime7, "RefreshAllDataConn"
    
    ' 打开文件时如果需要立刻执行一次可以保留下面这行，不需要就删掉
    RefreshAllDataConn
End Sub

3. 修改RefreshAllDataConn宏，执行完成后重新注册下一次任务 #

Sub RefreshAllDataConn()
    ' ----------------------
    ' 这里放你原本的宏业务逻辑
    ' ----------------------
    
    ' 执行完业务逻辑后，重新调度下一天的对应任务
    If Time < TimeValue("00:30:00") Then
        ' 本次是0点触发的，注册下一天0点的任务
        nextRunTime0 = Date + 1 + TimeValue("00:00:00")
        Application.OnTime nextRunTime0, "RefreshAllDataConn"
    ElseIf Time < TimeValue("07:30:00") Then
        ' 本次是7点触发的，注册下一天7点的任务
        nextRunTime7 = Date + 1 + TimeValue("07:00:00")
        Application.OnTime nextRunTime7, "RefreshAllDataConn"
    End If
End Sub

4. 新增Workbook_BeforeClose事件，取消未执行的定时任务（避免Excel报错或自动重启文件） #

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' 关闭文件前取消所有未触发的定时任务
    On Error Resume Next ' 防止任务已经执行完取消时报错
    Application.OnTime nextRunTime0, "RefreshAllDataConn", , False
    Application.OnTime nextRunTime7, "RefreshAllDataConn", , False
    On Error GoTo 0
End Sub

注意事项 #

• 需保持Excel程序和该工作簿处于打开状态，定时任务才会正常触发
• 打开文件时需要启用宏权限，否则所有VBA逻辑不会生效

内容的提问来源于stack exchange，提问作者Ivan Lorusso