按指定日期时间发送邮件的Excel VBA宏出现自动化错误

原代码的核心问题 #

• 延迟时间赋值错误：DeferredDeliveryTime属性要求传入单个合法的日期时间值，原代码直接传入Range("B2:C2")（多单元格区域）会触发类型不匹配的自动化错误。需要将B列的日期和C列的时间合并为一个完整的日期时间值。
• 未批量处理数据：原代码仅处理了B2:C2一行数据，未遍历B2:B10和C2:C10的所有目标行。
• 缺乏错误防护：未处理空单元格、无效日期时间或Outlook权限限制，容易引发异常。

修正后的VBA代码 #

Sub Send_Deferred_Mail_From_Excel()
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Dim rowNum As Integer
    Dim sendDateTime As Date
    
    ' 遍历B2到B10的所有行
    For rowNum = 2 To 10
        ' 跳过空单元格
        If IsEmpty(Range("B" & rowNum)) Or IsEmpty(Range("C" & rowNum)) Then
            GoTo NextRow
        End If
        
        ' 合并日期和时间为完整的发送时间，捕获格式错误
        On Error Resume Next
        sendDateTime = CDate(Range("B" & rowNum).Value + Range("C" & rowNum).Value)
        If Err.Number <> 0 Then
            MsgBox "第" & rowNum & "行的日期或时间格式无效，跳过该行", vbExclamation
            Err.Clear
            GoTo NextRow
        End If
        On Error GoTo 0
        
        ' 创建Outlook对象
        Set OutlookApp = CreateObject("Outlook.Application")
        Set OutlookMail = OutlookApp.CreateItem(0)
        
        ' 配置邮件内容
        With OutlookMail
            .To = "gaelvin@gmail.com"
            .CC = "nickjames@gmail.com"
            .BCC = ""
            .Subject = "Happy New Year"
            .Body = "Greeting Gael, Wish You a Very Happy New Year"
            ' 设置延迟发送时间
            .DeferredDeliveryTime = sendDateTime
            ' 显示邮件（替换为.Send可直接发送）
            .Display
        End With
        
        ' 释放对象
        Set OutlookMail = Nothing
        Set OutlookApp = Nothing
        
NextRow:
    Next rowNum
End Sub

关键注意事项 #

• 确保Outlook已启动，且在Outlook信任中心设置中允许宏访问（避免权限触发的自动化错误）
• 检查B列日期和C列时间是否为Excel可识别的日期/时间格式，合并后的sendDateTime必须是合法的日期时间值
• 若使用.Send直接发送，需确保Outlook的“自动发送/接收”功能正常，或手动触发发送接收

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