Solved

Set up to email multiple records as pdfs

Posted on 2016-11-11
4
16 Views
Last Modified: 2016-12-01
I want to push a button

it will open query

as query is opening I want to be able to fill in to variables

the 2 variables will filter to the correct group of record to process

once the query has selected the correct records

I would like each record send by email as a pdf

 

I can pull up one record at a time and email it as a pdf but when there are 65 it gets tedious
0
Comment
Question by:a52dragon
  • 2
4 Comments
 
LVL 119

Expert Comment

by:Rey Obrero
Comment Utility
- create a report based on the query
- use
       DoCmd.OutputTo acOutputReport, "myReport", acFormatPDF, "c:\folderName\myReport.pdf"

email the report as attachment
0
 
LVL 18

Accepted Solution

by:
crystal (strive4peace) - Microsoft MVP, Access earned 250 total points (awarded by participants)
Comment Utility
I assume you wish to send a filtered report to each employee (or whatever) and each report needs to be filtered for that criteria. If that is the case, here is some code you can modify.
Sub LoopAndEmail(psReport As String)
'161111 crystal
   
   On Error GoTo Proc_Err

   Dim sFilter As String _
      , sPath As String _
      , sFilename As String _
      , sEmailMessage As String _
      , sSQL As String _
      , nCount As Long

   Dim db As DAO.Database _
      , rs As DAO.Recordset _
      , oApp As Object _
      , oMsg As Object

   'initialize variables
   sPath = CurrentProject.Path & "\" 'or some other path
   nCount = 0
   
   'get list of employees and email addresses
   sSQL = "SELECT E.EmpID, E.Init, E.emailE, E.EmpFirst " _
      & " FROM Employees AS E " _
      & " WHERE (E.IsActiv=True)" _
      & ";"

   Set db = CurrentDb
   Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)
   
   'set reference to outlook
   Set oApp = CreateObject("Outlook.Application")

   'loop through each employee and filter the report
   With rs
      Do While Not .EOF
         'filter the report for the next record
         sFilter = "EmpID = " & !EmpID '---- customize criteria
         
         Call SetReportFilter(psReport, sFilter)
         
         'construct filename for this report
         sFilename = sPath & !Init & "_MyReportDescription_" & Format(Date, "yy-mm-dd") & ".PDF"  '---- customize filename
         
         'output filtered report to a PDF
         DoCmd.OutputTo acOutputReport, psReport, acFormatPDF, sFilename
         
         'create email and attach report
         Set oMsg = oApp.CreateItem(0) 'olMailItem=0
         
         oMsg.To = !emailE '---- customize who this goes to
         oMsg.subject = "Your report is attached" '---- customize subject
         oMsg.Body = "Hello " & !EmpFirst _
            & vbCrLf & vbCrLf & "Report generated " & Now & " is attached" '---- customize message
         oMsg.Attachments.Add sFilename
         oMsg.send
      
         nCount = nCount + 1
GetTheNextRecord:
         .MoveNext
      Loop
      
      'close the recordset
      .Close
   End With

   'release the recordset object variable
   Set rs = Nothing
   
   'give user a message
   If MsgBox(nCount & " reports were written to " & sPath & " and emailed" _
      & vbCrLf & vbCrLf & "Open the folder?" _
      , vbYesNo, "Done creating PDF files and emailing") = vbYes Then
         Application.FollowHyperlink sPath
   End If

Proc_Exit:
   On Error Resume Next
   'release object variables
   If Not rs Is Nothing Then
      rs.Close
      Set rs = Nothing
   End If
   Set db = Nothing
   Set oMsg = Nothing
   Set oApp = Nothing
   Exit Sub
  
Proc_Err:
   If Err.Number = 2501 Then 'report cancelled
      Resume GetTheNextRecord
   Else
      MsgBox Err.Description, , _
           "ERROR " & Err.Number _
           & "   LoopAndEmail "
   
      Resume Proc_Exit
      Resume
   End If
End Sub 

Open in new window

this procedure will also be needed:
Sub SetReportFilter(pReportName As String, pFilter As String)
 
   ' written by crystal (strive4peace)
 
   ' PARAMETERS:
   ' pReportName is the name of your report
   ' pFilter is a valid filter string
  
   ' USEAGE:
   ' SetReportFilter "MyReportname","someID=1000"
   ' SetReportFilter "MyAppointments","City='New York' AND dt_appt=#12/18/65#"
  
   On Error GoTo Proc_Err
 
   '---------- declare variables
   Dim rpt As Report
 
   '----------  open design view of report and set the report object variable
   DoCmd.OpenReport pReportName, acViewDesign
   Set rpt = Reports(pReportName)
  
   '---------- set report filter and turn it on
   rpt.Filter = pFilter
   
   rpt.FilterOn = IIf(Len(pFilter) > 0, True, False)
  
   '---------- save and close the changed report
   DoCmd.Save acReport, pReportName
   DoCmd.Close acReport, pReportName
  
   '----------  Release object variable
   Set rpt = Nothing
 
Proc_Exit:
   On Error Resume Next
   'release object variables
   Set rpt = Nothing
   Exit Sub 'or Exit Function
  
Proc_Err:
   MsgBox Err.Description, , _
        "ERROR " & Err.Number _
        & "   SetReportFilter "

   Resume Proc_Exit
   Resume
End Sub

Open in new window

you will also need code on the report NoData event to cancel the report if it does not have records (unless, of course, you want to send empty reports)
Private Sub Report_NoData(Cancel As Integer)
'161111 s4p
   Cancel = True
End Sub

Open in new window

0
 
LVL 31

Assisted Solution

by:Helen_Feddema
Helen_Feddema earned 250 total points (awarded by participants)
Comment Utility
Here is some code to created filtered reports and save them as PDFs:

Public Sub SendPDFEmails()
'Created by Helen Feddema 24-Jan-2010
'Last modified by Helen Feddema 24-Jan-2010

On Error GoTo ErrorHandler

   Dim appOutlook As New Outlook.Application
   Dim dbs As DAO.Database
   Dim lngCount As Long
   Dim lngEmployeeCount As Long
   Dim lngID As Long
   Dim msg As Outlook.MailItem
   Dim rpt As Access.Report
   Dim rstEmployees As DAO.Recordset
   Dim strAttachmentsPath As String
   Dim strBody As String
   Dim strEmployeeName As String
   Dim strEMailAddress As String
   Dim strPrompt As String
   Dim strQuery As String
   Dim strRecordSource As String
   Dim strReportFile As String
   Dim strReportName As String
   Dim strSQL As String
   Dim strSubject As String
   Dim strTitle As String
   
   strAttachmentsPath = GetProperty("AttachmentsPath", "") & "\"
   strSubject = GetProperty("MessageSubject", "Your custom report")
   strBody = GetProperty("MessageBody", "Your current report is attached as a PDF")
   strReportName = "rptEmployeeInvoices"
   Set dbs = CurrentDb
   Set rstEmployees = dbs.OpenRecordset("qryEMailEmployees")
   lngEmployeeCount = rstEmployees.RecordCount
   Debug.Print lngEmployeeCount & " employees need reports"

   If lngEmployeeCount = 0 Then
      strTitle = "No reports to send"
      strPrompt = "No employees need reports; canceling"
      MsgBox prompt:=strPrompt, _
         buttons:=vbExclamation + vbOKOnly, _
         Title:=strTitle
      GoTo ErrorHandlerExit
   End If
   
   Do While Not rstEmployees.EOF
      lngID = rstEmployees![EmployeeID]
      strEmployeeName = rstEmployees![Salesperson]
      strEMailAddress = rstEmployees![Email]
      strReportFile = strAttachmentsPath & "Employee Invoices" _
         & " for " & strEmployeeName & ".pdf"
      Debug.Print "PDF save name and path: " & strReportFile
      
      'Create filtered query as report record source
      strRecordSource = "qryInvoices"
      strQuery = "qryInvoicesPerEmployee"
      
      If lngID <> 0 Then
         strSQL = "SELECT * FROM " & strRecordSource & " WHERE " _
            & "[EmployeeID] = " & lngID & ";"
      End If
   
      Debug.Print "SQL for " & strQuery & ": " & strSQL
      lngCount = CreateAndTestQuery(strQuery, strSQL)
      
      'Output customized report to PDF
      DoCmd.OutputTo objecttype:=acOutputReport, _
         objectname:=strReportName, _
         outputformat:=acFormatPDF, _
         outputfile:=strReportFile, _
         autostart:=False
      
      'Create new mail message and send to employee
      Set msg = appOutlook.CreateItem(olMailItem)
      With msg
         .To = strEMailAddress
         .Subject = strSubject
         .Body = strBody
         .Attachments.Add strReportFile
         .Send
      End With
   
NextEmployee:
      rstEmployees.MoveNext
   Loop
   
   strTitle = "Done"
   strPrompt = lngEmployeeCount & " PDFs created and emailed"
   MsgBox prompt:=strPrompt, _
      buttons:=vbInformation + vbOKOnly, _
      Title:=strTitle

ErrorHandlerExit:
   Exit Sub

ErrorHandler:
   MsgBox "Error No: " & Err.Number _
      & " in SendPDFEmails procedure; " _
      & "Description: " & Err.Description
   Resume ErrorHandlerExit

End Sub

=======================
Public Function CreateAndTestQuery(strTestQuery As String, _
   strTestSQL As String) As Long
'Created by Helen Feddema 28-Jul-2002
'Last modified 6-Dec-2009

On Error Resume Next
   
   Dim qdf As DAO.QueryDef
   
   'Delete old query
   Set dbs = CurrentDb
   dbs.QueryDefs.Delete strTestQuery

On Error GoTo ErrorHandler
   
   'Create new query
   Set qdf = dbs.CreateQueryDef(strTestQuery, strTestSQL)
   
   'Test whether there are any records
   Set rst = dbs.OpenRecordset(strTestQuery)
   With rst
      .MoveFirst
      .MoveLast
      CreateAndTestQuery = .RecordCount
   End With
   
ErrorHandlerExit:
   Exit Function

ErrorHandler:
   If Err.Number = 3021 Then
      CreateAndTestQuery = 0
      Resume ErrorHandlerExit
   Else
   MsgBox "Error No: " & Err.Number _
      & " in CreateAndTestQuery procedure; " _
      & "Description: " & Err.Description
   End If
   
End Function

Open in new window

0
 
LVL 18
Comment Utility
solutions provided by experts
0

Featured Post

Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

Join & Write a Comment

The first two articles in this short series — Using a Criteria Form to Filter Records (http://www.experts-exchange.com/A_6069.html) and Building a Custom Filter (http://www.experts-exchange.com/A_6070.html) — discuss in some detail how a form can be…
In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now