Excel 根据列中的条件向具有（不同）多个附件的收件人发送电子邮件

我目前正在尝试编写一个宏，它将根据每个列的名称旁边是否有X向收件人发送多个附件。 我在G列中有电子邮件地址，在H:R列中有11个不同的报告名称

到目前为止，我已经编写了一个宏，如果电子邮件收件人在H列中有X，它将发送一个附件（报告1），但我不确定如何编写宏，因此它将在H:R列中搜索X，并发送相应的报告（即，如果电子邮件收件人在H列和J列中有X，则我希望他们在同一封电子邮件中同时收到报告1和报告3）

如果我的解释很难理解，很抱歉。
非常感谢您的帮助

Private Sub CommandButton1_Click()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range
    Dim FileCell As Range
    Dim rng As Range


    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set sh = Sheets("Contacts")

    Set OutApp = CreateObject("Outlook.Application")

    For Each cell In sh.Columns("G").Cells.SpecialCells(xlCellTypeConstants)

        If cell.Value Like "?*@?*.?*" And _
            LCase(Cells(cell.Row, "H").Value) = "x" Then
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .to = cell.Value
                .Subject = "Report 1"
                .body = "Hi " & cell.Offset(0, -3).Value
            'Link file path for attachment
                .Attachments.Add ("C:\Users\smcelroy021218\Desktop\Email Macro Working.xlsm")
                .Display
            End With

            Set OutMail = Nothing
        End If
    Next cell

    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

---

您不会说文件路径来自何处：在本例中，我从工作表的第一行（即从H1:R1）获取它们

---

行“.Attachments.Add”（“C:\…）只是用于测试btw的虚拟文件。理想情况下，我希望宏从行“H1:R1”获取附件文件路径-对应于11个不同的报告列。谢谢！哈哈，比我快。顺便说一句，他在评论中提到路径在

H1:R1

@L42-我错过了，我想是很幸运吧！哇！太好了，非常感谢。只是快速跟进，它似乎没有找到我的文件路径（我确实将文件路径移动到了H2:R2，因为我现在包含了标题）但我相应地更改了代码。这可能看起来是一个很小的问题，但我是否将完整的文件路径包含到单元格中？例如C:\Users\SMcelroy02218\Desktop\Email Macro Working.xlsm再次感谢您的帮助。要从第2行中提取，请使用：

.Attachments.Add sh.Cells（2，C.Column）.Value

我不确定我是否理解您关于如何包含完整路径的问题。如果您的所有附件都在同一文件夹中，您可以将文件名放在H2:R2中，并使用类似于

.attachments.Add的内容。添加“C:\Users\smcelry021218\Desktop\”和sh.Cells（2，C.Column）.Value

Ahhh抱歉，文件路径出现了愚蠢的错误。非常感谢您的帮助，非常感谢！

Private Sub CommandButton1_Click()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range, c As Range
    Dim FileCell As Range
    Dim rng As Range, rngAttach As Range

    Set sh = Sheets("Contacts")

    Set OutApp = CreateObject("Outlook.Application")

    For Each cell In sh.Columns("G").Cells.SpecialCells(xlCellTypeConstants)

        Set rngAttach = cell.Offset(0, 7).Resize(1, 11)

        'EDIT: must have at least one attachment to create a mail
        If cell.Value Like "?*@?*.?*" And _
                          Application.Countif(rngAttach, "x") > 0 Then

            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .to = cell.Value
                .Subject = "Report 1"
                .body = "Hi " & cell.Offset(0, -3).Value

                'loop over H:R and check for "x"
                For Each c In rngAttach.Cells
                    If LCase(Trim(c.Value)) = "x" Then
                        'pick up the file path from the top row of the sheet
                        .Attachments.Add sh.Cells(1, c.Column).Value
                    End If
                Next c

                .Display
            End With

            Set OutMail = Nothing

        End If
    Next cell

    Set OutApp = Nothing

End Sub