如何通过单元格中的路径和文件名添加邮件附件？

针对你需要为多用户生成带附件邮件、且文件路径与文件名分开存储在单元格的需求，以下是修改后的VBA代码，替换原有的文件选择器逻辑，直接从Excel单元格读取路径和文件名来拼接附件：

Private Sub CommandButton1_Click()
    Dim xOutApp As Outlook.Application
    Dim xMailOut As Outlook.MailItem
    Dim lastRow As Long
    Dim i As Long
    Dim fullFilePath As String
    
    Application.ScreenUpdating = False
    
    ' 创建Outlook应用实例
    Set xOutApp = CreateObject("Outlook.Application")
    
    ' 获取数据最后一行（假设数据从第2行开始，第1行为表头）
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 遍历每一行用户数据
    For i = 2 To lastRow
        ' 拼接完整附件路径：路径 + 文件名
        fullFilePath = Trim(Cells(i, "A").Value) & "\" & Trim(Cells(i, "B").Value)
        
        ' 检查文件是否存在，避免报错
        If Dir(fullFilePath) <> "" Then
            Set xMailOut = xOutApp.CreateItem(olMailItem)
            
            With xMailOut
                .To = Trim(Cells(i, "C").Value)
                .CC = Trim(Cells(i, "D").Value)
                .BCC = Trim(Cells(i, "E").Value)
                .Subject = Trim(Cells(i, "F").Value)
                .Body = Trim(Cells(i, "G").Value)
                ' 添加附件
                .Attachments.Add fullFilePath
                ' 显示邮件，若需直接发送可替换为 .Send
                .Display
            End With
            
            Set xMailOut = Nothing
        Else
            ' 文件不存在时弹出提示
            MsgBox "第" & i & "行的附件文件不存在：" & fullFilePath, vbExclamation
        End If
    Next i
    
    Set xOutApp = Nothing
    Application.ScreenUpdating = True
    MsgBox "批量邮件生成完成", vbInformation
End Sub

关键说明 #

• 列对应关系：请根据你的实际表格调整列标识：
  • A列：文件路径（如C:\Documents\Reports）
  • B列：文件名（如Q3_Summary.pdf）
  • C列：收件人邮箱
  • D列：抄送邮箱
  • E列：密送邮箱
  • F列：邮件主题
  • G列：邮件正文
• 文件存在校验：通过Dir()函数检查拼接后的路径是否有效，避免因文件缺失导致代码崩溃
• 批量处理：自动遍历所有数据行，直到A列无内容的空行停止
• 邮件操作：当前使用.Display显示邮件供手动确认，若需自动发送可替换为.Send（注意Outlook的安全设置限制）

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