CODEWITHSUNDEEP
vbaemail-attachments
Lisa Burns
Lisa Burns

Reputation: 1

ACCESS VBA to Send emails to addressees where an attached ACCESS PDF Report aligns that specific address

I've been putting this code together for a few days now with some success. My code will save pdf reports by project number so my battle is half won. The second part is where I am needing help getting each pdf report to automatically send to the project's email(Proj Mgr Emial) in the table.

tblEmailProjects

enter image description here

Additionally, while I can generate a single email (should be two) in the ".Display" mode, it attaches all the project's pdf reports instead of just the pdf report belonging to that recipient.

Single email generated by code

enter image description here

Finally, my variable strList causes an Runtime error "'-2147221238 The item has been moved or deleted" even tho it has been declared and set

I think/I hope I am close and would really appreciate any help...

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

Upvotes: 0

Views: 419

Answers (1)

Harun24hr
Harun24hr

Reputation: 36880

What I will suggest you split your codes into two part. First part will saves pdf to your desired folder and second part will send mail to users with individual attachment. Below is code to send mail to individuals with separate pdf attachment. First test it from an command button then include these codes to your codes. It will be easier then to deploy.

Read this post.

I hope you are aware about Add References 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

Upvotes: 1

Related Questions