Go Premium for a chance to win a PS4. Enter to Win


Batch email reports in access

Posted on 2013-12-19
Medium Priority
Last Modified: 2014-01-13
Thanks to help from the experts I have a database that batch creates pdfs for a list of trader accounts, saving them in a "orders" directory with the name being the trader number and date of preperation. The format for the file name is "XXXX YYYY-MM-DD".pdf with the XXXX being replaced by each traders 4 digit trader number. This part works great - now I am hoping to automatically email these reports. I have a table called "trading groups" that includes among other things a trader number that corresponds to the "XXXX" in the file name, along with 1 or more email addresses that the reports for that book needs to go to. Some of the books have 1 email address, some have 3 - in essence the reports for that book number need to go to whichever addresses are listed for each trader number in the "trader groups" database.

There may be several reports on a daily basis that do not have an email address associated with them, so I need to be able to skip those.
Question by:jtbold2
  • 2
  • 2
  • 2
  • +1
LVL 40

Expert Comment

ID: 39730851
Here's code from one of my applications.  It reads a recordset and sends out an email to each company on the list.  The procedure uses two tables to keep track of missing email addresses and errors and empties them out at the start of the procedure.  It also posts status to the form that invokes the procedure.
Private Sub cmdSendEmails_Click()
    Dim strValue As String
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim rs2 As DAO.Recordset
    Dim qd As DAO.QueryDef
    Dim td As DAO.TableDef
    Dim strMsg As String
    Dim StartTime As Date
    Dim EndTime As Date
    Dim stDocName As String
    Dim QUOTE As String
    Dim DocName As String
    Dim strPath As Variant
    Dim strSQL As String
    Dim CountErr As Integer
    Dim TestEmail As Boolean
    Dim strEmail As String
On Error GoTo ErrProc

    QUOTE = """"
    CountErr = 0
    Set db = CurrentDb()
    stDocName = "Inspectors report"
    TestEmail = DLookup("TestEmail", "tblEmail", "RecID = 1")
    'get path
    strPath = DLookup("FileFolder", "tblEMail", "RecID = 1")
    If strPath & "" = "" Then
        MsgBox "Please open email defaults form and add document path.", vbOKOnly
        Exit Sub
    End If
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If

    'delete old email errors
    strSQL = "Delete * From tblNoEmailAddress"
    DoCmd.SetWarnings False
    DoCmd.Hourglass True
    DoCmd.RunSQL strSQL
    strSQL = "Delete * From tblEmailErrors"
    DoCmd.RunSQL strSQL
    DoCmd.SetWarnings True
    DoCmd.Hourglass False
    'open email error recordset.
    Set td = db.TableDefs!tblNoEmailAddress
    Set rs2 = td.OpenRecordset
    Set qd = db.QueryDefs!qGetIRDataJobs
    Set rs = qd.OpenRecordset
    StartTime = Now()
    Me.lblElapsedTime.Visible = False
    Me.lblStatus.Visible = True
    Me.lblStatus.Caption = "Sending Emails...."
    DoCmd.Hourglass (True)
    ' Create the Outlook session.
        'Set oOL = CreateObject("Outlook.Application")
        'Set oOL = New Outlook.Application
    On Error Resume Next
    Set oOL = GetObject(, "Outlook.Application")

    If Err.Number = 429 Then
        Set oOL = CreateObject("Outlook.application")
    End If

    On Error GoTo ErrProc

    If Me.txtJob & "" = "" Then
        Do Until rs.EOF = True
            Me.txtJob = rs!Job
            GoSub PrintOrEmail
        GoSub PrintOrEmail
    End If
    'Close outlook session
    Set oOL = Nothing
    DoCmd.Hourglass (False)
    DoCmd.SetWarnings (True)
    Me.lblStatus.Caption = "Complete"
    EndTime = Now()
    Me.lblStatus.Visible = True
    Me.lblElapsedTime.Visible = True
    Me.lblElapsedTime.Caption = DateDiff("n", StartTime, EndTime) & " Minutes"
    'close recordsets
    If CountErr > 0 Then
        DoCmd.OpenReport "rptNoEmailAddress", acViewPreview
        MsgBox "All reports were emailed.", vbOKOnly
    End If
    If DCount("*", "tblEMailErrors") > 0 Then
        DoCmd.OpenReport "rptEMailErrors", acViewPreview
    End If
    Exit Sub
    DocName = strPath & rs!Job & "_" & Format(Date, "yyyymmdd") & ".pdf"
    If rs!IR_Email & "" = "" Then
        DoCmd.OpenReport stDocName, acViewNormal
            rs2!Job = Me.txtJob
            rs2!PrintDate = Now()
        CountErr = CountErr + 1
        Kill DocName    'delete existing file if any so outputto won't hang
        DoCmd.OutputTo acOutputReport, stDocName, acFormatPDF, DocName, False
        ' send the PDF via outlook
        If TestEmail = True Then
            strEmail = "mfalaguerra@safetymarking.net"
            strEmail = rs!IR_Email
        End If
        strValue = Email_Via_Outlook(strEmail, "Quantity Review Report", "", False, DocName)
    End If
    Select Case Err.Number
        Case 53 'file not found
            Resume Next
        Case Else
            MsgBox Err.Number & "--" & Err.Description
            Resume Next
    End Select
End Sub

Open in new window

LVL 85
ID: 39731580
patrickmatthews has a nice article on Automating Outlook from VBA:


It's lengthy, but the essential parts for you would be the "Sending Emails" part. You can use this to create your email, and to add Attachments to your emails. Patrick has example code in the article, so I won't go into that, but essentially you include his OutlookCreateItem class in your VBA project, after which you can use that code as needed. There is an Excel and Access example at the end - use the Access demo as your template.

The format for the file name is "XXXX YYYY-MM-DD".pdf with the XXXX being replaced by each traders 4 digit trader number.
So the "XXXX" is from your recordset, but is the YYYY-MM-DD always the "current date" - that is, if I send the email today (12-20-2013) for Trader numer 0099, would I expect to find a PDF named "0099-2103-12-20.pdf"? What happens if I create the reports today, and try to send them tomorrow? Could that happen?

How is your "Trading Groups" table structured? You mention there could be more than one Email address to which a single report would need to be sent. Do you have a separate table that houses those email addresses, and is that table related back to "Trading Groups"? Or do you have multiple Email addresses stored in a single table, like columns named Email1, Email2, etc?

Author Comment

ID: 39731666
yes the YYYYY-MM-DD is the "current date," the reports will always be sent out the day they are created, and then deleted- the email addresses are in the trading groups tables and you guessed my simplistic method - email1, email2 etc.

Yes the name of the pdf for trader 0099 would be "0099 2103-12-20.pdf"

view of directory
a picture of my target directory with two files run as a test yesterday, there are actually 50 or so "books" that get a report.
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

LVL 40

Expert Comment

ID: 39731793
Oops.  I just noticed that I didn't include the email part.  I'll post it tonight if you still need it.  I am at a client site all day and don't have that sample with me.
LVL 85
ID: 39732322
Without knowing how many of those "Emailxx" fields you have:

Essentially you would loop through the table, and gather the email addresses. For example:

Dim rst As DAO.Recordset
Set rst = Currentdb.OpenRecordset("SELECT * FROM YourTable")

Do While Not rst.EOF
  Dim sEmail as String
  If Nz(rst("Email1"), "") <> "" Then
    sEmail = rst("Email1")
  End If
  If Nz(rst("Email2", "") <> "" Then
    sEmail = sEmail & ";" & rst("Email2")
  End If
  '/ and so on for Email3, Email4, etc

sEmail would now contain the semicolon-delimited list of email addresses.

To get the attachment, you'd get the TraderNumber and build up the string:

Dim sFile As String
sFile = "C:\Orders\" & rst("Trader Number") & " " & Year(Now) & "-" & Month(Now) & "-" & Day(Now) & ".pdf"

<now use the OutlookCreateItem class to send the email with the attachment>

Obviously you'd have to change "C:\Orders" to match the path on your system.

Also, you may need to format the Date string in that PDF name, depending on how you actually create the name of the PDF. If you create it using padded values, like 2014-01-01. For Jan. 1, 2014, then you'll need to use that same formatting when locating the attachment.

Author Comment

ID: 39732342
thanks, that makes me think that I can use more or less the same logic I used to create the file name to pick up the attachment'...

strPathName = CurrentProject.Path & "\orders\" & rs!trader & " " & Format(Now(), "yyyy-mm-dd") & ".pdf"
LVL 31

Accepted Solution

Helen Feddema earned 2000 total points
ID: 39732468
Here is some code that creates a PDF for each record, and emails it as an attachment:

Public Sub SendInterventionEmails()
'Created by Helen Feddema 10-Jan-2010
'Last modified by Helen Feddema 10-Jan-2010

On Error GoTo ErrorHandler

   Dim appOutlook As New Outlook.Application
   Dim itm As Outlook.MailItem
   Dim rstIntervention As DAO.Recordset
   Dim lngCount As Long
   Dim lngID As Long
   Dim rpt As Access.Report
   Dim strFileName As String
   Dim strPrompt As String
   Dim strQuery As String
   Dim strRecordSource As String
   Dim strReport As String
   Dim strSQL As String
   Dim strTitle As String
   Dim strCurrentPath As String
   Dim strFileNameAndPath As String
   Dim strEmailSource As String
   strEmailSource = "qryInterventionEmail"
   strRecordSource = "qryMissingAssignments"
   strQuery = "qryMissingAssignmentsSingleStudent"
   Set dbs = CurrentDb
   Set rstIntervention = dbs.OpenRecordset(strEmailSource)
   strCurrentPath = Application.CurrentProject.Path & "\"
   'Use path selected with SelectFolder procedure
   'strCurrentPath = SelectFolder()

   With rstIntervention
      Do While Not .EOF
         lngID = ![StID]
         Debug.Print "Processing Student ID " & lngID
         strFileName = "Intervention Report for " & ![StFirst] _
            & " " & ![StLast] & ".pdf"
         strFileNameAndPath = strCurrentPath & strFileName
         'Create filtered query
         strSQL = "SELECT * FROM " & strRecordSource & " WHERE " _
            & "[StID] = " & Chr(39) & lngID & Chr(39) & ";"
         Debug.Print "SQL for " & strQuery & ": " & strSQL
         lngCount = CreateAndTestQuery(strQuery, strSQL)
         Debug.Print "No. of items found: " & lngCount
         If lngCount = 0 Then
            GoTo NextStudent
         End If
         'Open report with filtered query record source
         strReport = "rptMissingAssignmentsNew"
         DoCmd.OpenReport ReportName:=strReport, _
            View:=acViewPreview, _
         Set rpt = Reports(strReport)
         DoCmd.OutputTo objecttype:=acOutputReport, _
            objectname:=strReport, _
            outputformat:=acFormatPDF, _
         'Create email
         Set itm = appOutlook.CreateItem(olMailItem)
         itm.Subject = "MISSING WORK"
         itm.Body = "The attached file lists your missing assignments"
         itm.To = ![Email]
         itm.Attachments.Add Source:=strFileNameAndPath, _
         'For editing before sending
         'For sending automatically
         DoCmd.Close objecttype:=acReport, _
            objectname:=strReport, _

   End With
   Exit Sub

   MsgBox "Error No: " & Err.Number _
      & " in SendInterventionEmails 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 by Helen Feddema 10-Jan-2010

On Error Resume Next
   '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
      CreateAndTestQuery = .RecordCount
   End With
   Exit Function

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

Open in new window


Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Question has a verified solution.

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

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
This article describes a method of delivering Word templates for use in merging Access data to Word documents, that requires no computer knowledge on the part of the recipient -- the templates are saved in table fields, and are extracted and install…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…
Look below the covers at a subform control , and the form that is inside it. Explore properties and see how easy it is to aggregate, get statistics, and synchronize results for your data. A Microsoft Access subform is used to show relevant calcul…
Suggested Courses

971 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