求助：编写VBA实现未找到文件时跳过附件仅添加存在文件

需求：编写VBA代码实现当文件夹中不存在指定文件时，跳过该文件的附件添加操作，仅添加存在的文件。尝试添加If Then语句但未成功，寻求帮助。当前VBA代码片段如下：

With objEmail
.To = 
.Cc = 
.Subject = 
'.HTMLBody = RangetoHTML(rng)
.HTMLBody = StrBody2 & "<br>" & RangetoHTML(rng) & "<br>" & StrBody3 & "<br>" & .HTMLBody

 pdfFileName1 = Dir(pdfFolderPath1 & "file.pdf")
 pdfFileName5 = Dir(pdfFolderPath4 & "file2.pdf")
 pdfFileName6 = Dir(pdfFolderPath4 & "file3.pdf")
 pdfFileName2 = Dir(pdfFolderPath2 & "file4.pdf")
 pdfFileName3 = Dir(pdfFolderPath3 & "file5.pdf")
 pdfFileName4 = Dir(pdfFolderPath3 & "file6.pdf")
       
            pdfFilePath1 = pdfFolderPath1 & pdfFileName1
            pdfFilePath2 = pdfFolderPath2 & pdfFileName2
            pdfFilePath3 = pdfFolderPath3 & pdfFileName3
            pdfFilePath4 = pdfFolderPath3 & pdfFileName4
            pdfFilePath5 = pdfFolderPath4 & pdfFileName5
            pdfFilePath5 = pdfFolderPath4 & pdfFileName6
                
                .Attachments.Add pdfFilePath1, , , pdfFileName1
           
                 .Attachments.Add pdfFilePath2, , , pdfFileName2
            
              pdfFileName = Dir
            
        
                .Attachments.Add pdfFilePath3, , , pdfFileName3
                .Attachments.Add pdfFilePath4, , , pdfFileName4
                .Attachments.Add pdfFilePath5, , , pdfFileName5
                .Attachments.Add pdfFilePath5, , , pdfFileName6
                    
       
.Display ' DISPLAY MESSAGE.

End With
With Application

End Sub

修正后的代码 #

With objEmail
    .To = "" ' 补充收件人信息
    .Cc = "" ' 补充抄送人信息
    .Subject = "" ' 补充邮件主题
    '.HTMLBody = RangetoHTML(rng)
    .HTMLBody = StrBody2 & "<br>" & RangetoHTML(rng) & "<br>" & StrBody3 & "<br>" & .HTMLBody

    ' 为每个文件定义完整路径
    Dim pdfPath1 As String: pdfPath1 = pdfFolderPath1 & "file.pdf"
    Dim pdfPath2 As String: pdfPath2 = pdfFolderPath2 & "file4.pdf"
    Dim pdfPath3 As String: pdfPath3 = pdfFolderPath3 & "file5.pdf"
    Dim pdfPath4 As String: pdfPath4 = pdfFolderPath3 & "file6.pdf"
    Dim pdfPath5 As String: pdfPath5 = pdfFolderPath4 & "file2.pdf"
    Dim pdfPath6 As String: pdfPath6 = pdfFolderPath4 & "file3.pdf"
    
    ' 逐个判断文件是否存在，存在则添加附件
    If Dir(pdfPath1) <> "" Then
        .Attachments.Add pdfPath1, , , "file.pdf"
    End If
    
    If Dir(pdfPath2) <> "" Then
        .Attachments.Add pdfPath2, , , "file4.pdf"
    End If
    
    If Dir(pdfPath3) <> "" Then
        .Attachments.Add pdfPath3, , , "file5.pdf"
    End If
    
    If Dir(pdfPath4) <> "" Then
        .Attachments.Add pdfPath4, , , "file6.pdf"
    End If
    
    If Dir(pdfPath5) <> "" Then
        .Attachments.Add pdfPath5, , , "file2.pdf"
    End If
    
    If Dir(pdfPath6) <> "" Then
        .Attachments.Add pdfPath6, , , "file3.pdf"
    End If
    
    .Display ' 显示邮件
End With
' 补充Application相关收尾操作（如还原屏幕更新状态）
With Application
    ' 示例：.ScreenUpdating = True
End With
End Sub

关键改动说明 #

• 文件存在性判断：利用Dir(文件路径)函数，若返回空字符串则代表文件不存在，直接跳过附件添加操作
• 修复路径赋值错误：原代码中pdfFilePath5被重复赋值，导致file3.pdf的路径被覆盖，修正后为每个文件单独定义独立路径变量
• 简化逻辑：直接使用完整路径进行判断，无需额外存储文件名变量，减少冗余代码
• 可读性优化：添加统一缩进与变量注释，拆分重复的赋值与判断逻辑，便于后续维护

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