ACCESS VBA可以将电子邮件发送给收件人，附件的ACCESS PDF报告将其与该特定地址对齐

如何解决ACCESS VBA可以将电子邮件发送给收件人，附件的ACCESS PDF报告将其与该特定地址对齐

我已经将这些代码放在一起几天了，并取得了一些成功。我的代码将按项目编号保存pdf报告，因此我的战斗赢了一半。第二部分是我需要帮助的地方，以获得每个pdf报告以自动发送到表中的项目电子邮件（Proj Mgr Emial）。

tblEmailProjects

此外，虽然我可以在“ .Display”模式下生成一封电子邮件（应为两封），但它会附加项目的所有pdf报告，而不只是附件中属于该收件人的pdf报告。

由代码生成的单个电子邮件

最后，即使声明并设置了变量，我的变量strList也会导致运行时错误“'-2147221238该项已被移动或删除”

我认为/我希望我能与我保持密切联系，非常感谢您的帮助...

Dim olApp As Object
 Dim olMail As Object
 Dim strExport As String
 Dim strList As String
 Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(olMailItem)
 
Dim rst As DAO.Recordset

'Public strRptFilter As String   ' not need to use a public variable

Set rst = CurrentDb.OpenRecordset("SELECT DISTINCT [Proj_Nbr],[Project Mgr Emial] FROM  [TblEmailProjects] ORDER BY [Proj_Nbr];",dbOpenSnapshot)

If rst.RecordCount > 0 Then ' make sure that we have data

    rst.MoveFirst

Do While Not rst.EOF
    strRptFilter = "[Proj_Nbr] = " & Chr(34) & rst![Proj_Nbr] & Chr(34)
    
     DoCmd.OpenReport "rptProjCost",acViewPreview,strRptFilter,acHidden   ' open the report hidden in preview mode setting the where parameter

     DoCmd.OutputTo acOutputReport,"rptProjCost",acFormatPDF,"C:\Users\Lisa Burns\Documents\AJI\Deploy DELPHI Projects\" & rst![Proj_Nbr] & ".pdf"  ' save the opened report
     
     DoCmd.Close acReport,"rptProjCost" ' close the report
     
    strExport = "C:\Users\Lisa Burns\Documents\AJI\Deploy DELPHI Projects\" & rst![Proj_Nbr] & ".pdf"
    strList = rst![Project Mgr Emial] ' ******ERRORS HERE WHEN ACTUALLY TRYING TO SEND EMAILS INSTEAD OF JUST DISPLAYING.&_
    'WHEN DISPLAYING ONLY ONE EMAIL SHOWING LAST EMAIL ADDRESS IN THE RECORDsET*****
      
With olMail
    
    .To = strList  '******ERRORS HERE WHEN ACTUALLY TRYING TO SEND EMAILS INSTEAD OF JUST DISPLAYING
    .CC = "" 'Change if you want a CC
    .BCC = "" 'Change is you want a BCC
    .Subject = "Project Costs for" & "rst![Proj_Nbr]" '****CODE DOES NOT CAPTURE PROJ_NBR...INCORRECT SYNTAX?"
    .Body = "Attached,please find your project cost report for project number & rst![Proj_Nbr]." 'Change to what ever you want the body of the email to say
    'Attaches the exported file using the variable created at beginning
    .Attachments.Add strExport '*****ADDS ALL REPORTS INSTEAD OF FILTERING THE PDF REPORT THAT IS APPROPRIATE FOR THE RECIPIENT****
    .Display 'Use for testing purposes only,note out for live runs '.Send 'Use for live purposes only.
    
End With

 DoEvents
    rst.MoveNext
Loop

End If ' rst.RecordCount > 0

'Frees email objects stored in memory
Set olMail = Nothing
Set olApp = Nothing
'stop added here
rst.Close
Set rst = Nothing
End Sub

解决方法

我建议您将代码分为两部分。第一部分将pdf保存到所需的文件夹中，第二部分将通过单独附件将邮件发送给用户。以下是将邮件发送给带有单独pdf附件的个人的代码。首先从命令按钮进行测试，然后将这些代码包含在您的代码中。部署起来会更容易。

Read this post.

希望您了解添加引用Microsoft Outlook x.xx Object Library。

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\Lisa Burns\Documents\AJI\Deploy DELPHI Projects\" 'Change the path with your folder path

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

Set db = CurrentDb()
Set rs = db.OpenRecordset("SELECT DISTINCT [Proj_Nbr],[Project Mgr Emial] FROM  [TblEmailProjects]",dbOpenSnapshot)

    On Error Resume Next 'Suppress errors 
    Do While Not rs.EOF
        strAttachment = mypath & rs![Proj_Nbr] & ".pdf"  'Pdf name exactly as employee ID.
        strEmail = rs![Project Mgr Emial] '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