要发送的宏将不同的文件附加到多个单独的电子邮件，VBA

Question

我是计算机技术员，而不是程序员，但是在我的新工作中，我被要求在excel（vba）中完成宏。 它由一列中的身份证号码组成（每次使用时，单元格的数量是可变的，例如一天可以放置20个人，另外12个人则是可变的），而电子邮件则在另一列中。 文件夹中有一些pdf文档，其名称是excel中出现的人的身份证。

他们问我的是，被要求按照字母顺序排列身份证，然后拿走身份证和电子邮件。身份证将用于查找您相应的pdf文件，并将其添加为附件，以通过电子邮件将其发送给谁？在那里该单元格与电子邮件数据一起使用。必须对每个现有行进行此操作，获取pdf文件进行附加，然后将电子邮件发送到该行的地址，直到工作表上没有更多行为止。

有人可以告诉我该怎么做或告诉我我需要的功能吗？

谢谢。

图形提示：

Answer 1

该宏当前设置为.Display电子邮件，但不发送。完成测试运行后，您需要将其更改为.Send才能实际发送电子邮件。

您还需要更新strLocation的值。在引号内是需要放置用于存放所有目标PDF的文件夹的位置。

这里的单元格顺序无关紧要，只要每一行都与一个人相关联。

希望这些电子邮件是内部的-您不能将其用于外部邮件列表，因为您无法提供退订选项。如果怀疑您有垃圾邮件，Outlook可能会标记/禁止您的帐户。

这假设Column C中的值是Outlook可以识别的实际电子邮件地址。 （ urdearboy@email.com ）

---

Sub CorpCard()

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup

For Each cell In Columns("C").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "?*@?*.?*" Then
        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .SentOnBehalfOfName = "[your associated Outlook email here]"
            .to = cell.Value
                .Subject = "Subject goes here"
                .Body = "Hi " & Range("B" & cell.Row).Value & "," _

                'Body to be patsed here

            strLocation = "C:\Users\urdearboy\Desktop\File Name\" & Cells(cell.Row, "D").Value & ".pdf"
            .Attachments.Add (strLocation)
        .Display
        '.Send
        End With

        On Error GoTo 0
        Set OutMail = Nothing
    End If
Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub