VBA每日倒计时邮件宏运行报错求助：溢出/对象不支持属性或方法

错误原因分析 #

1. Runtime Error 6（溢出）：daysLeft声明为Integer类型，该类型取值范围仅为-32768~32767，当目标日期与当前日期的差值超出此范围（比如目标日期早于当前日期很久）时，就会触发溢出报错。
2. Runtime Error 438（对象不支持属性/方法）：主要有两个诱因：
   • Outlook对象实例创建逻辑不完善，若未正确获取或创建Outlook进程，会导致后续邮件对象调用失败；
   • Application.OnTime调度逻辑错误：原代码仅指定时间未指定日期，若当前时间已过设定的发送点，会立即触发执行，且重复调度当天的同一时间，引发逻辑混乱，进而导致对象调用异常。
3. 全局变量targetDate依赖Excel进程存活，一旦Excel重启，变量值会丢失，导致后续天数计算错误。

修复后的完整代码 #

Sub ScheduleEmail()
    ' 调度第二天指定时间执行发送邮件宏
    Application.OnTime Date + 1 + TimeValue("05:53:00"), "SendCountdownEmail"
End Sub

Sub SendCountdownEmail()
    Dim olApp As Object
    Dim olMail As Object
    Dim targetDate As Date
    Dim daysLeft As Long ' 改用Long类型避免溢出
    
    ' 每次执行重新设置目标日期，规避全局变量丢失问题
    targetDate = DateValue("2024-01-14")
    
    ' 用DateDiff计算剩余天数，更安全且返回值为Long类型
    daysLeft = DateDiff("d", Date, targetDate)

    ' 优先获取已运行的Outlook实例，失败再新建
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    
    If olApp Is Nothing Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    
    ' 创建并配置邮件
    Set olMail = olApp.CreateItem(0)
    With olMail
        .To = "sam.wilson@toyota.com"
        .Subject = "Countdown to Special Day"
        ' 处理不同日期状态的邮件内容
        If daysLeft > 0 Then
            .Body = "There are " & daysLeft & " days left until January 14, 2024."
        ElseIf daysLeft = 0 Then
            .Body = "Today is the special day: January 14, 2024!"
        Else
            .Body = "The special day (January 14, 2024) has passed by " & Abs(daysLeft) & " days."
        End If
        .Send
    End With

    ' 清理对象释放资源
    Set olMail = Nothing
    Set olApp = Nothing

    ' 调度下一天的发送任务
    Application.OnTime Date + 1 + TimeValue("05:53:00"), "SendCountdownEmail"
End Sub

关键修复点 #

• 类型替换：将daysLeft从Integer改为Long，支持更大的数值范围，彻底解决溢出问题；
• 安全计算天数：使用DateDiff("d", Date, targetDate)替代直接日期相减，逻辑更清晰且返回值为Long类型，进一步规避溢出风险；
• 优化Outlook实例创建：先尝试获取已运行的Outlook进程，失败再新建，减少重复启动Outlook的概率，降低对象调用异常；
• 修复调度逻辑：用Date + 1 + TimeValue("05:53:00")明确指定第二天的发送时间，避免当天时间已过时的重复执行问题；
• 移除全局变量：在SendCountdownEmail内部重新定义targetDate，避免Excel重启后变量丢失；
• 增加异常场景处理：针对目标日期已过、当天就是目标日期的情况，生成对应提示内容，提升实用性。

补充：停止自动任务的代码 #

若需终止每日发送任务，可执行以下宏：

Sub CancelSchedule()
    On Error Resume Next
    Application.OnTime Date + 1 + TimeValue("05:53:00"), "SendCountdownEmail", , False
    On Error GoTo 0
End Sub

内容的提问来源于stack exchange，提问作者Samuel Wilson