VBA设置每日指定时间自动触发文件备份运行失败问题求助

核心故障原因 #

• 现有代码写死注册当日13:25的定时，若打开文件/上次触发时间已经超过当日13:25，新注册的定时会直接失效，无法触发
• 未配置工作簿启动自动注册定时的逻辑，每次打开文件都要手动运行SaveBackup才能生效
• Backup子程序中先注册定时再执行备份，若备份过程报错中断，会导致后续定时逻辑混乱

修复后完整代码 #

1. 标准模块代码（放置你现有SaveBackup和Backup的模块中） #

' 公共变量存储下次触发时间，用于取消定时（可选）
Public nextTrigger As Date

' 注册下次备份定时
Sub RegisterBackupTrigger()
    Dim targetTime As Date
    targetTime = TimeValue("13:25:00")
    
    ' 若当前时间已过今日目标时间，就注册明日的
    If Now() > Date + targetTime Then
        nextTrigger = Date + 1 + targetTime
    Else
        nextTrigger = Date + targetTime
    End If
    
    ' 注册定时
    Application.OnTime EarliestTime:=nextTrigger, Procedure:="Backup", Schedule:=True
End Sub

' 备份主逻辑
Sub Backup()
    On Error GoTo ErrHandler
    ' 先执行备份
    ThisWorkbook.SaveCopyAs Filename:="Z:\Global\Quality\Expired FG and 31's\" & "FG Expiration Test" & " " & Format(Now(), "MM.DD.YYYY") & ".xlsm"
    
    ' 备份成功后注册下一次定时
    RegisterBackupTrigger
    Exit Sub
    
ErrHandler:
    ' 报错可以加弹窗提醒，也可以直接写日志，根据需要调整
    MsgBox "备份失败，错误原因：" & Err.Description, vbCritical
    ' 报错后也注册下次定时，避免后续不再触发
    RegisterBackupTrigger
End Sub

2. ThisWorkbook对象代码 #

双击工程资源管理器中的ThisWorkbook，粘贴以下代码，实现打开文件自动注册定时：

Private Sub Workbook_Open()
    ' 打开文件自动注册备份定时
    RegisterBackupTrigger
End Sub

' 可选：关闭文件时取消已注册的定时，避免后台报错
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    Application.OnTime EarliestTime:=nextTrigger, Procedure:="Backup", Schedule:=False
    On Error GoTo 0
End Sub

注意事项 #

• 必须保持该Excel文件在触发时间点处于打开状态，且宏已启用，定时才会正常生效
• 若修改了目标触发时间，重新打开文件或手动运行一次RegisterBackupTrigger即可更新定时
• 若使用网络盘路径存储备份，需确保触发时间点网络连通、路径有权限写入

内容的提问来源于stack exchange，提问作者Alex Brouwer