Solved

Batch email reports in access

Posted on 2013-12-19
7
505 Views
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.
0
Comment
Question by:jtbold2
  • 2
  • 2
  • 2
  • +1
7 Comments
 
LVL 34

Expert Comment

by:PatHartman
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...."
    Me.Recalc
    DoEvents
    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
            rs.MoveNext
        Loop
    Else
        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
    rs.Close
    rs2.Close
    If CountErr > 0 Then
        DoCmd.OpenReport "rptNoEmailAddress", acViewPreview
    Else
        MsgBox "All reports were emailed.", vbOKOnly
    End If
    If DCount("*", "tblEMailErrors") > 0 Then
        DoCmd.OpenReport "rptEMailErrors", acViewPreview
    End If
ExitProc:
    Exit Sub
    
PrintOrEmail:
    DocName = strPath & rs!Job & "_" & Format(Date, "yyyymmdd") & ".pdf"
    If rs!IR_Email & "" = "" Then
        DoCmd.OpenReport stDocName, acViewNormal
        rs2.AddNew
            rs2!Job = Me.txtJob
            rs2!PrintDate = Now()
        rs2.Update
        CountErr = CountErr + 1
    Else
        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"
        Else
            strEmail = rs!IR_Email
        End If
        
        strValue = Email_Via_Outlook(strEmail, "Quantity Review Report", "", False, DocName)
    End If
    Return
ErrProc:
    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

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

http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/A_4316-Automate-Outlook-in-VBA-with-the-OutlookCreateItem-Class.html

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?
0
 

Author Comment

by:jtbold2
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.
0
Get up to 2TB FREE CLOUD per backup license!

An exclusive Black Friday offer just for Expert Exchange audience! Buy any of our top-rated backup solutions & get up to 2TB free cloud per system! Perform local & cloud backup in the same step, and restore instantly—anytime, anywhere. Grab this deal now before it disappears!

 
LVL 34

Expert Comment

by:PatHartman
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.
0
 
LVL 84
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
  rst.MoveNext
Loop

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.
0
 

Author Comment

by:jtbold2
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"
0
 
LVL 31

Accepted Solution

by:
Helen_Feddema earned 500 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, _
            windowmode:=acWindowNormal
         Set rpt = Reports(strReport)
         DoCmd.OutputTo objecttype:=acOutputReport, _
            objectname:=strReport, _
            outputformat:=acFormatPDF, _
            outputfile:=strFileNameAndPath
         
         '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, _
            Type:=olByValue
         
         'For editing before sending
         itm.Display
         
         'For sending automatically
         'itm.Send
         DoCmd.Close objecttype:=acReport, _
            objectname:=strReport, _
            Save:=acSaveNo

NextStudent:
         .MoveNext
      Loop
   End With
   
ErrorHandlerExit:
   Exit Sub

ErrorHandler:
   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
      .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

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

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…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…

760 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

23 Experts available now in Live!

Get 1:1 Help Now