使用Dir函数添加邮件附件时出现“验证路径和文件名是否正确”错误

错误原因 #

1. 附件缺少完整路径：Dir()函数返回的只是文件名，不是完整路径。emailItem.Attachments.Add fileName只传文件名时，Outlook会在默认路径（通常是Excel当前工作簿所在目录）查找文件，而非你指定的C:\Users\DW1085\Downloads\a\，因此找不到文件触发错误。
2. 重复复用同一邮件对象：原代码在循环外创建emailItem，每次循环会在同一封邮件中重复添加附件，即使路径问题解决，也会导致逻辑错误（后续邮件带之前所有附件）。

修正后的代码 #

Sub AttachAndEmail()
    Dim fileDirectory As String
    Dim fileName As String
    Dim emailApplication As Object
    Dim emailItem As Object

    ' 初始化Outlook应用
    On Error Resume Next
    Set emailApplication = GetObject(, "Outlook.Application")
    If Err.Number > 0 Then Set emailApplication = CreateObject("Outlook.Application")
    On Error GoTo 0

    Application.ScreenUpdating = False

    fileDirectory = "C:\Users\DW1085\Downloads\a\"
    fileName = Dir(fileDirectory)

    Do While Len(fileName) > 0
        ' 每次循环新建一封邮件
        Set emailItem = emailApplication.CreateItem(0)
        
        With emailItem
            .To = "Myname@email.com"
            .Subject = "WowweWow"
            .Body = "Yup"
            ' 拼接完整文件路径
            .Attachments.Add fileDirectory & fileName
            .Display
        End With

        ' 释放对象，避免内存占用
        Set emailItem = Nothing
        fileName = Dir
    Loop

    Application.ScreenUpdating = True
End Sub

关键修改说明 #

• 拼接完整路径：用fileDirectory & fileName生成完整的文件路径，确保Outlook能准确定位到附件。
• 循环内新建邮件对象：把Set emailItem = emailApplication.CreateItem(0)移到循环内部，每次循环创建新邮件，避免重复添加附件。
• 使用With语句：简化代码结构，让邮件属性设置更清晰。
• 释放对象：循环结束后释放emailItem对象，减少内存占用。

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