VBA宏创建带附件Outlook邮件报错，需实现无附件时发特定邮件

现有代码的问题 #

• 错误处理时机错误：On Error Resume Next放在添加附件之后，附件不存在时已经触发报错，没起到捕获错误的作用。
• 逻辑顺序混乱：应该先检查文件是否存在，再决定创建哪种邮件，而非先尝试创建带附件的邮件再回头修改。
• 变量大小写不统一：outmail未和声明的OutMail保持一致，存在潜在风险。

修正后的代码 #

Sub DailyReports()
    Dim strLocation As String
    Dim OutApp As Object
    Dim OutMail As Object
    
    ' 初始化Outlook应用
    Set OutApp = CreateObject("Outlook.Application")
    
    ' 拼接每日报告的附件路径
    strLocation = "C:\Users\Corey G\Dropbox\Vetsure Access Database\Spreadsheets\VSR\PHP Scott Veterinary Clinic" & Format(Now(), " YYYYMMDD") & ".xlsx"
    
    ' 先判断文件是否存在，分支处理两种邮件场景
    If Dir(strLocation) <> "" Then
        ' 文件存在：创建带附件的常规报告邮件
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = "收件人邮箱地址" ' 替换为实际收件人
            .CC = "抄送人邮箱地址" ' 替换为实际抄送人
            .BCC = "密送人邮箱地址" ' 替换为实际密送人
            .Subject = "每日报告" ' 替换为实际主题
            .Body = "这是今日的报告，请查收。" ' 替换为实际正文
            .Attachments.Add strLocation ' 添加目标附件
            .Display ' 显示邮件，如需自动发送可替换为.Send
        End With
    Else
        ' 文件不存在：创建"今日无报告"的通知邮件
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = "收件人邮箱地址" ' 替换为实际收件人
            .CC = "抄送人邮箱地址" ' 替换为实际抄送人
            .BCC = "密送人邮箱地址" ' 替换为实际密送人
            .Subject = "No Report Today"
            .Body = "今日无报告。" ' 替换为实际正文
            .Display ' 显示邮件，如需自动发送可替换为.Send
        End With
    End If
    
    ' 释放对象，避免内存占用
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

关键修改说明 #

• 前置文件检查：用Dir(strLocation) <> ""提前判断文件状态，从根源避免附件不存在的报错。
• 拆分邮件逻辑：两种场景分别创建独立的邮件对象，避免互相干扰。
• 补充占位提示：标注了需要替换的收件人、主题、正文等内容，方便直接套用。

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