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

问题描述

我有一个带命令按钮的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

解决方法

由于您已经具有生成.pdf文件的代码，因此请使用以下代码将电子邮件发送到带有单独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

ms-access ms-access-2007