如何让VBA脚本不发送无附件的Outlook邮件

问题分析 #

你的代码里On Error Resume Next会忽略所有错误，包括附件添加失败的情况，而且Else分支里的next是语法错误，导致判断逻辑完全失效。另外，依赖错误处理来判断附件是否存在不够稳妥，建议提前检查文件是否存在。

修改后的代码 #

Sub CreateStatement()
    Dim EApp As Object
    Set EApp = CreateObject("Outlook.Application")
    
    Dim EItem As Object
    Dim path As String
    path = "K:\E-Fax Invoicing\PDF Output\"
    
    Dim RList As Range
    Set RList = Range("A2", Range("A2").End(xlDown))
    
    Dim R As Range
    Dim attachmentPath As String
    
    For Each R In RList
        Set EItem = EApp.CreateItem(0)
        attachmentPath = path & R.Offset(0, 3).Value ' 明确获取附件路径
        
        With EItem
            On Error Resume Next ' 仅处理邮箱地址相关错误
            .SentOnBehalfOfName = ""
            .To = R.Offset(0, 2).Value
            On Error GoTo 0 ' 关闭错误捕获，避免干扰后续逻辑
            
            .Subject = "December Statement: "
            .Body = "Dear " & R.Value & vbNewLine & vbNewLine _
                  & "Please find your " & R.Offset(0, 4).Value & " attached."
            
            ' 先检查文件是否存在，再添加附件
            If Dir(attachmentPath) <> "" Then
                .Attachments.Add attachmentPath
                .Send ' 确认有附件才发送
            Else
                ' 无附件则直接丢弃当前邮件对象，跳过发送
                Set EItem = Nothing
            End If
        End With
    Next R
    
    Set EApp = Nothing
    Set EItem = Nothing
End Sub

关键调整点 #

• 提前检查文件存在性：用Dir(attachmentPath) <> ""判断附件文件是否存在，比依赖错误处理更可靠，也能避免错误捕获带来的其他隐性问题。
• 缩小错误捕获范围：把On Error Resume Next仅放在设置邮箱地址的代码段，专门处理找不到/无效邮箱的情况，之后立即关闭错误捕获，不影响附件的判断逻辑。
• 修正语法错误：移除无效的next语句，改为无附件时直接释放当前邮件对象，跳过发送步骤。
• 明确单元格取值：给单元格操作加上.Value，避免隐式转换可能带来的异常。

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