Access Archon #170
Introduction
Several earlier Access Archon articles have dealt with various aspects of mass emailings. In Access Archon #106 I described how to send mass emailings from an Access table, in Access Archon #135 I described how to send reports as attachments for a mass emailing, and in Access Archon #148 I described how to create and send customized reports as email attachments. In recent years it has become more and more difficult to send emails with large attachments (or more correctly, less and less likely that they will be received) because of increasing Outlook security measures, so (at the request of reader Charles Hui) I have rewritten the code that does mass emailing with attachments to just place a link in the email, so the users can download the file either from a network drive or from a Web site.
Access 2007 allows you to save reports in PDF format, at least if you have the PDF add-in installed, so this article has two sample databases: an Access 2002-2003 database in which reports are created as snapshots, and an Access 2007 database in which reports are created as PDF files. (Access 2002 or higher is needed, because the code uses the FileDialog object, new to Office XP.)
Access 2000-2003 Database
The main menu of the sample Mass Report Link EMailing (AA 170).mdb database calls the CreateSnapshots procedure from its Load event to create snapshots of the unfiltered reports, so they will be available for emailing (if they have not already been created). If you have not already selected a report path, a FolderPicker dialog opens so you can select a path. The main menu is shown in Figure A:
Figure A. The main menu of the Access 2002-2003 sample database
The top button sends the same report (one of the reports whose snapshots were just created) to all contacts selected from the listbox on frmEMailMerge, as shown in Figure B.
Figure B. A form for selecting a report for mailing a link to selected contacts
The second button creates a customized report for each of the selected employees; the snapshots are created as needed when the emails are sent. The frmEMailCustomReport form has a listbox of employees instead of contacts, and it lacks the combo box for selecting a report, since only one report (rptEmployeeInvoices) is sent, filtered by Employee ID (so each employee gets a custom report). This form is shown in Figure C.
Figure C. A form for emailing customized report links to selected employees
VBA Code
The procedures that do the report saving and email creation are listed below:
basEMailing Module
Public Function CreateSnapshots()
On Error GoTo ErrorHandler
Dim strSnapshot As String
Dim rstReports As DAO.Recordset
Dim blnNeedSnapshot As Boolean
blnNeedSnapshot = False
Set dbs = CurrentDb
Set rstReports = dbs.OpenRecordset(“tlkpReports”)
Set fso = CreateObject(“Scripting.FileSystemObject”)
strFilePath = GetReportsPath()
Debug.Print “File path for saved reports: ” & strFilePath
strExtension = “.snp”
Do While Not rstReports.EOF
If rstReports![Filtered] = False Then
strReport = rstReports![ObjectName]
strFileName = rstReports![DisplayName]
strSnapshot = strFilePath & strFileName & strExtension
Debug.Print “Report to attach: ” & strSnapshot
‘Skip creating snapshot file, if it already exists
If fso.FileExists(strSnapshot) = True Then
GoTo NextSnapshot
Else
‘Create new snapshot file in Reports folder
blnNeedSnapshot = True
DoCmd.OutputTo objecttype:=acOutputReport, _
ObjectName:=strReport, _
outputformat:=acFormatSNP, _
outputfile:=strSnapshot, _
autostart:=False
End If
TryAgain:
‘Test for existence of specified report file, with loop
‘to prevent premature cancellation
Set fso = CreateObject(“Scripting.FileSystemObject”)
If fso.FileExists(strSnapshot) = False Then
GoTo TryAgain
End If
End If
NextSnapshot:
rstReports.MoveNext
Loop
rstReports.Close
If blnNeedSnapshot = True Then
MsgBox “Snapshots created”, vbInformation + vbOKOnly
End If
ErrorHandlerExit:
Exit Function
ErrorHandler:
MsgBox “Error No: ” & Err.Number & “; Description: ” & _
Err.Description
Resume ErrorHandlerExit
End Function
frmEMailMerge Form Module
Private Sub cmdSendEMail_Click()
On Error GoTo ErrorHandler
Dim intLinkType As Integer
Dim strReportNameHTML As String
Dim strReportFile As String
Dim strHTML As String
‘Test for required fields
strReportName = Nz(Me![cboSelectReport].Column(1))
If strReportName = “Please select a report” Then
strTitle = “No report selected”
strPrompt = “Prompt”
MsgBox prompt:=strPrompt, _
buttons:=vbExclamation + vbOKOnly, _
Title:=strTitle
Me![cboSelectReport].SetFocus
GoTo ErrorHandlerExit
Else
strReportName = GetReportsPath & strReportName & “.snp”
End If
strRecipients = Me![txtRecipients].Value
If strRecipients = “” Then
strTitle = “No recipients selected”
strPrompt = “Please select recipient(s)”
MsgBox prompt:=strPrompt, _
buttons:=vbExclamation + vbOKOnly, _
Title:=strTitle
Me![lstSelectContacts].SetFocus
GoTo ErrorHandlerExit
End If
strSubject = Me![txtMessageSubject].Value
If strSubject = “” Then
strTitle = “No subject entered”
strPrompt = “Please enter a subject”
MsgBox prompt:=strPrompt, _
buttons:=vbExclamation + vbOKOnly, _
Title:=strTitle
Me![txtMessageSubject].SetFocus
GoTo ErrorHandlerExit
End If
strBody = Me![txtMessageBody].Value
If strBody = “” Then
strTitle = “No message body entered”
strPrompt = “Please enter message body text”
MsgBox prompt:=strPrompt, _
buttons:=vbExclamation + vbOKOnly, _
Title:=strTitle
Me![txtMessageBody].SetFocus
GoTo ErrorHandlerExit
End If
‘Create HTML string
strReportNameHTML = Replace(expression:=strReportName, _
Find:=” “, Replace:=”%20”)
intLinkType = Nz(Me![fraLinkType].Value, 1)
If intLinkType = 1 Then
strReportFile = strReportNameHTML & Chr(34)
strHTML = “
file:///” & strReportFile _
& “>Download Report from network drive
“
ElseIf intLinkType = 2 Then
strReportFile = strReportNameHTML & Chr(34)
‘Replace my Web site with yours
strHTML = “
& “http://www.helenfeddema.com/Files/” _
& strReportFile & “>Download Report from the Internet
“
End If
Debug.Print “HTML: ” & strHTML
‘Create new mail message and send to contacts
Set msg = appOutlook.CreateItem(olMailItem)
With msg
.To = strRecipients
.Subject = strSubject
.Body = strBody
.HTMLBody = strBody & strHTML
.Display
‘Remove the single quote from the line below
‘to send the email automatically
‘.Send
End With
ErrorHandlerExit:
Exit Sub
ErrorHandler:
MsgBox “Error No: ” & Err.Number & “; Description: ” & Err.Description
Resume ErrorHandlerExit
End Sub
Supporting Files
The zip file containing this article, in Word 97-2003 format, plus the supporting file(s), may be downloaded from the Access Archon page of my Web site. It is accarch170.zip, which is the last entry in the table of Access Archon columns for Access Watch.
|
Document Name |
Document Type |
Place in |
|
Mass Report Link Emailing (AA 170).mdb |
Access 2002-2003 database | |
|
Mass Report Link Emailing (AA 170).accdb |
Access 2007 database |
Wherever you want |
