问题描述
我已经将这些代码放在一起几天了，并取得了一些成功。我的代码将按项目编号保存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附件的个人的代码。首先从命令按钮进行测试，然后将这些代码包含在您的代码中。部署起来会更容易。
希望您了解添加引用
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