Solved

Set up to email multiple records as pdfs

Posted on 2016-11-11
4
30 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 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 41884351
- create a report based on the query
- use
       DoCmd.OutputTo acOutputReport, "myReport", acFormatPDF, "c:\folderName\myReport.pdf"

email the report as attachment
0
 
LVL 19

Accepted Solution

by:
crystal (strive4peace) - Microsoft MVP, Access earned 250 total points (awarded by participants)
ID: 41884443
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)
ID: 41884763
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 19
ID: 41908426
solutions provided by experts
0

Featured Post

Enterprise Mobility and BYOD For Dummies

Like “For Dummies” books, you can read this in whatever order you choose and learn about mobility and BYOD; and how to put a competitive mobile infrastructure in place. Developed for SMBs and large enterprises alike, you will find helpful use cases, planning, and implementation.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
sql statement - 9 24
Any Way to Print an Import Spec? 3 29
Access on Mouse move 5 30
Access VBA, adding Progress Bar in code to allow execution. 7 28
Experts-Exchange is a great place to come for help with solutions for your database issues, and many problems are resolved within minutes of being posted.  Others take a little more time and effort and often providing a sample database is very helpf…
Introduction The Visual Basic for Applications (VBA) language is at the heart of every application that you write. It is your key to taking Access beyond the world of wizards into a world where anything is possible. This article introduces you to…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Using Microsoft Access, learn some simple rules for how to construct tables in a relational database. Split up all multi-value fields into single values: Split up fields that belong to other things into separate tables: Make sure that all record…

776 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