单元格多逗号分隔文件路径发邮件报错，单文件正常的技术求助

错误原因 #

当单元格内的文件路径用逗号分隔时，Split拆分后的元素大概率带有前后空格（比如单元格内容为"C:\doc1.pdf, C:\doc2.pdf"，拆分后第二个路径是" C:\doc2.pdf"），或者存在空元素（比如单元格末尾多打了逗号），这些情况都会导致Outlook无法识别有效路径，触发-2147024773错误。

修复方案 #

对拆分后的每个路径做两步处理：

• 用Trim()函数去除前后空格
• 判断路径是否为空，为空则跳过添加

同时优化代码逻辑，将Outlook应用对象的创建移到循环外，减少资源重复消耗。

修改后的完整代码 #

Sub Preview()
    Dim SendTo As String
    Dim ToMSg As String
    Dim AttachmentsArray As Variant
    Dim Subj As String
    Dim Item As Variant
    Dim i As Integer
    
    ' 提前创建Outlook对象，避免循环内重复实例化
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Set OutlookApp = CreateObject("Outlook.Application")
    
    i = 2
    Do
        SendTo = ThisWorkbook.Sheets(1).Cells(i, "F").Value
        ToMSg = ThisWorkbook.Sheets(1).Cells(i, "I").Value
        AttachmentsArray = Split(ThisWorkbook.Sheets(1).Cells(i, "J").Value, ",")
        Subj = ThisWorkbook.Sheets(1).Cells(i, "H").Value
        
        Set OutlookMail = OutlookApp.CreateItem(0)
        With OutlookMail
            .To = SendTo
            .CC = ""
            .BCC = ""
            .Subject = Subj
            .Body = ToMSg
            
            ' 处理每个附件路径，过滤无效内容
            For Each Item In AttachmentsArray
                Dim cleanPath As String
                cleanPath = Trim(Item)
                ' 仅当路径非空时添加附件
                If cleanPath <> "" Then
                    .Attachments.Add cleanPath
                End If
            Next
            
            .Display
        End With
       
        Set OutlookMail = Nothing
        i = i + 1
    Loop Until ThisWorkbook.Sheets(1).Cells(i, "A").Value = ""
    
    ' 释放Outlook对象资源
    Set OutlookApp = Nothing
    Application.DisplayAlerts = True
End Sub

额外注意事项 #

• 确保单元格内的路径都是绝对路径，相对路径可能导致识别失败
• 检查路径中是否包含特殊字符（比如中文全角逗号），若有需替换为半角逗号后再拆分

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