需求：仅当存在附件且有有效邮箱地址时发送邮件（附VBA代码）

以下是满足需求的完整代码，已添加邮箱地址校验、附件存在性检查，并调整为直接发送邮件（替代原有的显示邮件）：

Sub CreateStatement()
    Dim EApp As Object
    Set EApp = CreateObject("Outlook.Application")

    Dim EItem As Object
    Dim path As String
    path = "K:\"

    Dim RList As Range
    Set RList = Range("A2", Range("A2").End(xlDown))

    Dim R As Range
    Dim recipientEmail As String
    Dim attachmentPath As String

    For Each R In RList
        ' 获取收件人邮箱地址并去除首尾空格
        recipientEmail = Trim(R.Offset(0, 2).Value)
        ' 邮箱为空则跳过当前行
        If recipientEmail = "" Then
            GoTo NextRow
        End If

        ' 拼接附件完整路径并去除首尾空格
        attachmentPath = path & Trim(R.Offset(0, 3).Value)
        ' 检查附件文件是否存在，不存在则跳过当前行
        If Dir(attachmentPath) = "" Then
            GoTo NextRow
        End If

        ' 创建邮件项并配置内容
        Set EItem = EApp.CreateItem(0)
        With EItem
            .SentOnBehalfOfName = ""
            .To = recipientEmail
            .Subject = "December Statement: "
            .Attachments.Add attachmentPath
            .Body = "Dear " & R.Value & vbNewLine & vbNewLine _
                  & "Please find your " & R.Offset(0, 4).Value & " attached."
            .Send ' 直接发送邮件，测试阶段可改回.Display预览
        End With

NextRow:
        Set EItem = Nothing ' 释放当前邮件对象，避免内存占用
    Next R

    Set EApp = Nothing
End Sub

关键改动说明： #

• 邮箱地址校验：先提取并清理邮箱地址，若为空则直接跳过当前循环，不创建邮件。
• 附件存在性检查：通过Dir函数判断附件文件是否存在，避免因附件缺失触发运行时错误。
• 移除滥用的错误抑制：原代码的On Error Resume Next会掩盖各类异常，现在通过前置检查规避问题，逻辑更透明。
• 自动发送调整：将.Display替换为.Send，实现符合条件时自动发送邮件，测试时可改回.Display预览效果。
• 内存优化：每次循环末尾释放当前邮件对象，避免不必要的内存占用。

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