VBA如何在循环中为Outlook邮件批量添加多个附件？

问题根源 #

你代码里的错误由两个低级失误导致：

1. 循环变量和存储选中文件路径的数组重名，你用同一个fichier1既充当存路径的数组，又充当循环计数器，循环运行第一次就会把数组内容覆盖为索引数值，直接丢失原有文件路径信息
2. 添加附件时没有读取数组的对应下标元素，直接把整个数组传给了Attachments.Add方法，Outlook无法识别数组格式的路径参数

修复方案 #

把循环部分替换为独立的循环变量，读取数组对应下标的路径即可，修改后的完整代码如下：

Sub Send_Email()
    Dim MaMessagerie As Object
    Dim MonMessage As Object
    Dim fichier1 As Variant ' 显式声明变量，避免隐式声明异常
    Dim i As Long ' 独立循环变量
    
    Set MaMessagerie = CreateObject("Outlook.application")
    Set MonMessage = MaMessagerie.CreateItem(0)
    
    ' 多选文件
    fichier1 = Application.GetOpenFilename("File to send (*.XLS*), *.XLS*", _
                   Title:="Pick at least One file", _
                   MultiSelect:=True)
    
    ' 判断是否未选择文件
    If Not IsArray(fichier1) Then
        MsgBox "No file selected!", vbExclamation, "Attention"
        Exit Sub
    End If
    
    MonMessage.To = "myEmail@321.com"
    MonMessage.CC = ""
    
    ' 遍历文件数组添加附件
    For i = LBound(fichier1) To UBound(fichier1)
        MonMessage.Attachments.Add fichier1(i)
    Next i
    
    MonMessage.Subject = "Subject"
    MonMessage.Body = "test"
    MonMessage.Display
    'MonMessage.Send
    
    Set MaMessagerie = Nothing
    Set MonMessage = Nothing
End Sub

补充说明 #

修改后的代码仍然保持晚期绑定逻辑，不需要引用Outlook对象库，不会影响你其他宏的正常运行。同时清理了原有代码中未使用的冗余变量，补充了变量显式声明，避免隐式声明导致的其他潜在异常。

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