如何设置VBA的Button1_Click宏每5天自动触发运行？

核心思路 #

Application.OnTime 支持直接用日期+时间的组合作为触发时间，不用局限在TimeValue的小时范围内。直接用 Now + 5 就能表示当前时间的5天后，以此实现长周期触发。同时要调整原有短间隔循环的逻辑，改成完成整个流程后预约下一次5天后的执行。

修改后的完整代码 #

Sub Button1_Click()
    ' 直接启动流程，去掉不必要的10秒延迟
    Part1
End Sub

Sub Part1()
    Call DeleteFiles
    ' 预约20秒后执行Part2
    Application.OnTime Now + TimeValue("00:00:20"), "Part2"
End Sub

Sub Part2()
    Call CopyFiles_r2
    ' 预约55秒后执行Part3
    Application.OnTime Now + TimeValue("00:00:55"), "Part3"
End Sub

Sub Part3()
    Call MakeFolders
    ' 预约1分40秒后执行Part4
    Application.OnTime Now + TimeValue("00:01:40"), "Part4"
End Sub

Sub Part4()
    Call moveMatchedFilesInAppropriateFolders
    ' 预约1分55秒后执行Part5
    Application.OnTime Now + TimeValue("00:01:55"), "Part5"
End Sub

Sub Part5()
    Call OrganizeFilesByFileType
    ' 预约5天后的当前时间，再次启动整个流程
    Application.OnTime Now + 5, "Button1_Click"
End Sub

关键调整说明 #

• 删掉了Button1_Click里的10秒延迟，直接启动Part1，减少无意义等待
• 把Part5最后一行的短间隔循环（原本00:02:35后调用Part1）改成5天后调用Button1_Click，让整个流程每5天完整执行一次
• Now + 5 是合法的参数，代表当前日期时间加5天，完全适配Application.OnTime的要求

额外注意事项 #

• 必须保证Excel在触发时间点处于打开状态，Application.OnTime只有在Excel运行时才会生效
• 如果需要取消已预约的触发，可以加个取消宏，记得先把预约时间存到全局变量里：

  ' 在模块顶部声明全局变量，用来存储预约的时间
  Dim nextRunTime As Date
  
  Sub Part5()
      Call OrganizeFilesByFileType
      nextRunTime = Now + 5
      Application.OnTime nextRunTime, "Button1_Click"
  End Sub
  
  ' 取消下一次预约的宏
  Sub CancelNextRun()
      On Error Resume Next ' 没有预约时忽略错误
      Application.OnTime nextRunTime, "Button1_Click", Schedule:=False
      On Error GoTo 0
  End Sub
  

内容的提问来源于stack exchange，提问作者Salman Shafi