如何让VBA批量邮件发送代码忽略空路径的可变数量附件？

要让空路径的附件自动跳过，只需给每个添加附件的操作加非空判断，同时优化Outlook对象的创建逻辑，避免重复实例化。以下是修改后的完整代码：

Sub send_mass_email_display_only()

    Dim i As Integer
    Dim name As String, email As String, body As String, subject As String, copy As String
    Dim pdfadd1 As String, pdfadd2 As String, pdfadd3 As String, pdfadd4 As String, pdfadd5 As String
    Dim OutApp As Object
    Dim OutMail As Object
    
    body = ActiveSheet.TextBoxes("TextBox 1").Text
    
    ' 只创建一次Outlook应用，提升运行效率
    Set OutApp = CreateObject("Outlook.Application")
    
    For i = 2 To 3
        'Specific rows
        
        name = Split(Cells(i, 1).Value, " ")(0)
        'name = Cells(i, 1).Value
        email = Cells(i, 2).Value
        subject = Cells(i, 3).Value
        copy = Cells(i, 4).Value
        pdfadd1 = Cells(i, 5).Value
        pdfadd2 = Cells(i, 6).Value
        pdfadd3 = Cells(i, 7).Value
        pdfadd4 = Cells(i, 8).Value
        pdfadd5 = Cells(i, 9).Value
        
        body = Replace(body, "C1", name)
        
        Set OutMail = OutApp.CreateItem(0)
        
        With OutMail
             .SentOnBehalfOfName = Cells(7, 17).Value
             .To = email
             .cc = copy
             .subject = subject
             .body = body
             
             ' 非空才添加附件，Trim过滤单元格空格避免误判
             If Len(Trim(pdfadd1)) > 0 Then
                 ' 可选：检查文件是否存在，避免无效路径报错
                 If Dir(pdfadd1) <> "" Then .Attachments.Add pdfadd1
             End If
             
             If Len(Trim(pdfadd2)) > 0 Then
                 If Dir(pdfadd2) <> "" Then .Attachments.Add pdfadd2
             End If
             
             If Len(Trim(pdfadd3)) > 0 Then
                 If Dir(pdfadd3) <> "" Then .Attachments.Add pdfadd3
             End If
             
             If Len(Trim(pdfadd4)) > 0 Then
                 If Dir(pdfadd4) <> "" Then .Attachments.Add pdfadd4
             End If
             
             If Len(Trim(pdfadd5)) > 0 Then
                 If Dir(pdfadd5) <> "" Then .Attachments.Add pdfadd5
             End If
             
             .display
             '.Send
        End With
    
        body = ActiveSheet.TextBoxes("TextBox 1").Text 'reset body text
        
        ' 释放当前邮件对象
        Set OutMail = Nothing
    Next i
    
    Set OutApp = Nothing
    
    'MsgBox "Email(s) Sent!"
    
End Sub

关键修改说明： #

• 非空判断：通过Len(Trim(pdfaddX)) > 0检查路径是否为空，Trim能过滤单元格内的空格，避免把空格误判为有效路径。
• 文件存在校验：新增Dir(pdfaddX) <> ""判断，确保路径对应的文件真实存在，进一步规避报错风险。
• 实例优化：将Set OutApp = CreateObject("Outlook.Application")移到循环外，避免每次循环都创建新的Outlook实例，提升运行效率。

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