如何基于筛选后表格的文件路径为Outlook邮件批量添加附件？

问题说明 #

现有VBA代码可生成Outlook邮件并插入筛选后的Table2到正文，但仅能固定添加G2单元格对应的文件作为附件，无法根据表格筛选结果自动添加G列所有可见行的对应文件。

修改方案 #

替换原代码中固定添加附件的单行代码，改为遍历Table2的G列可见单元格，逐个拼接文件路径并添加为附件。

核心修改代码 #

将原代码中的：

.attachments.Add "C:\RemoteAMBA\bin\SoftTokens\" & Range("g2").Value

替换为以下循环代码（注意替换"G列标题"为Table2中G列实际的表头名称）：

Dim cell As Range
' 遍历Table2中G列的所有可见单元格
For Each cell In Sheet4.ListObjects("Table2").ListColumns("G列标题").DataBodyRange.SpecialCells(xlCellTypeVisible)
    ' 跳过空白单元格，避免无效路径
    If Trim(cell.Value) <> "" Then
        .Attachments.Add "C:\RemoteAMBA\bin\SoftTokens\" & cell.Value
    End If
Next cell

完整修改后的代码 #

Sub Soft_Token_Distribution()
Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object
Dim cell As Range ' 新增变量用于遍历单元格

Set outlook = CreateObject("Outlook.Application")
Set newEmail = outlook.CreateItem(0)

With newEmail
    .To = Sheet4.Range("L2").Text
    .CC = ""
    .BCC = ""
    .Subject = "ADD SUBJECT LINE HERE"
    .HTMLBody = "Hi, <br/><br/> As part of your <b> Create, Modify or Terminate SOW Contingent Worker </b> ServiceNow request for the below user, you requested Remote Access for the user. <br/><br/> Vendor Remote Access has been provisioned for this user. Please share the attached documents with the user so that they can configure their Vendor Remote Access. <br/><br/> Regards,"
   
    ' 替换原附件代码，遍历G列可见单元格添加附件
    For Each cell In Sheet4.ListObjects("Table2").ListColumns("G列标题").DataBodyRange.SpecialCells(xlCellTypeVisible)
        If Trim(cell.Value) <> "" Then
            .Attachments.Add "C:\RemoteAMBA\bin\SoftTokens\" & cell.Value
        End If
    Next cell
    
    Set .SendUsingAccount = outlook.Session.Accounts.Item(2)
    
    .Display
    Set xInspect = newEmail.GetInspector
    Set pageEditor = xInspect.WordEditor
    
    Sheet4.Range("Table2[#All]").Copy
    
    pageEditor.Application.Selection.Start = 316
    pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start
    pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)
    
    .Display
    '.Send
    Set pageEditor = Nothing
    Set xInspect = Nothing
End With

Set newEmail = Nothing
Set outlook = Nothing
End Sub

注意事项 #

• 必须将代码中的"G列标题"替换为Table2中G列的实际表头名称（比如"文件名"），否则会报错。
• 确保G列的可见单元格中存储的是完整的文件名（包含扩展名，如token1.pdf），否则会找不到文件。
• 新增的空白单元格判断可避免因空值导致的附件添加失败。

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