将电子邮件发送到具有不同 pdf 附件的多个地址

Question

我有一个带有命令按钮的 Access 表单，可以打开报告并在本地文件夹中创建 .PDF 文件。每个 .PDF 报告都有不同的名称（1234.pdf、4321.pdf 等）。数字代表员工编号，报告是该员工当前的休假时间余额。所以基本上，我最终在文件夹中有大约 60 个 .PDF 文件，每个文件用于不同的员工。创建这些 .PDF 文件后，我希望通过 Access 将它们通过电子邮件发送给每个员工，并附上他们自己的 .PDF 附件，而不是我在 Outlook 中创建单独的电子邮件并手动附加文件。我知道如何将一个 .PDF 文件附件发送给一个或多个收件人，但不知道如何向单个收件人发送特定的 .PDF 文件附件。我在想也许文件可以在创建后立即发送，然后继续创建下一个文件，等等。我不知道。下面是我用来为每个员工编号创建 .PDF 文件的代码。顺便说一句，员工编号和电子邮件地址存储在同一个员工表中，如果有帮助的话。

Private Sub CmdAllLeavePDF_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim MyFileName As String
Dim mypath As String
Dim temp As String
Dim sNow As String

mypath = "C:\Users\rbryan_2\Desktop\EDM Reports PDF\"

sNow = Format(Now(), "mmddyyyy")

Set db = CurrentDb()

Set rs = db.OpenRecordset("SELECT DISTINCT [TblNames.EmpID] FROM [QurEmpLeaveCurrAll]", dbOpenSnapshot)

Do While Not rs.EOF

temp = rs("TblNames.EmpID")

MyFileName = rs("TblNames.EmpID") & " - " & sNow & ".PDF"

DoCmd.OpenReport "RptEmpLeaveCurrAll", acViewPreview, , "[TblNames.EmpID]='" & temp & "'"
DoCmd.OutputTo acOutputReport, "", acFormatPDF, mypath & MyFileName

DoCmd.Close acReport, "RptEmpLeaveCurrAll", acSaveYes
DoEvents

rs.MoveNext
Loop

rs.Close
Set rs = Nothing
Set db = Nothing

Beep
Eval ("MsgBox ('PDF FILES CREATED!@Individual Employee Leave Totals Reports Were Successfully Created@In The EDM Reports PDF File Folder.@@',64,' Employee Data Management')")
   
Me!CmdN.SetFocus

End Sub

Answer 1

由于您已经拥有生成.pdffiles 的代码，因此请使用以下代码将电子邮件发送到带有单独 pdf 的个人电子邮件地址。这里EmpID 是员工编号字段，Email 是员工电子邮件地址字段。如果您的电子邮件字段名称不同，请调整它。

希望您了解Add References Microsoft Outlook x.xx 对象库。

Option Compare Database
Option Explicit

Private Sub cmdSendMails_Click()
Dim oApp As New Outlook.Application
Dim oEmail As Outlook.MailItem
Dim strEmail As String, strAttachment As String
Dim mypath As String

mypath = "C:\Users\rbryan_2\Desktop\EDM Reports PDF\"
'mypath = "C:\Users\Harun.Rashid\Desktop\My PDFs\"

Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb()
Set rs = db.OpenRecordset("SELECT DISTINCT EmpID, EmpEmail FROM TblNames", dbOpenSnapshot)

    On Error Resume Next 'Suppress errors 
    Do While Not rs.EOF
        strAttachment = mypath & rs!EmpID & ".pdf"  'Pdf name exactly as employee ID.
        strEmail = rs!EmpEmail 'Email address from table column.
        
            Set oEmail = oApp.CreateItem(olMailItem)
            With oEmail
                .Recipients.Add strEmail 'Add email address
                .Subject = "Your subject text here."
                .Body = "Your body text here."
                .Attachments.Add strAttachment 'Attach PDF file.
                '.Send
                .Display 'Use .send to send the mail. Display will show the email editor window.
            End With
            Set oEmail = Nothing
        rs.MoveNext
    Loop

rs.Close
Set rs = Nothing
Set db = Nothing

End Sub