Parameterization of automated Access report in VBA

T

TigerTom

I am an Access newbie who’s trying to build a VBA procedure to automatically
email an Access report out once a day to several different users. I have
worked out the scheduling, the email, etc. The problem is I have not been
able to figure out how to customize the report to each user. Essentially, I
want to run the same report several times, once for each user, so that they
get only the data pertaining to their projects. While I know how to
parameterize a report based on form input, I have not been able to work out
how to parameterize an automated report. I’ve been spinning my wheels on this
for quite a while, so I would greatly appreciate any help.
 
D

Danny J. Lesandrini

Tom:

This might get deep pretty fast, but you're going to have to wrap your Send Report
code in a recordset cursor.

Can you post back the code that sends the report so I'll have some thing to work with?

Basically, what we'll do is to create a recordset of the people who should get the
report, grab the Key Field ID and output the reports one at a time, filtered for each
person. The recordset code will look like this ...


Dim db as DAO.Database
Dim rs As DAO.Recordset
Dim sSQL as String
Dim sWhere as String
Dim sEmail as String

sSQL = "SELECT PersonID, PersonEmail FROM tblPerson WHERE SendReport=True"
Set db = CurrentDb
Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)

Do Until rs.EOF
sWhere = "[PersonID]=" & rs!PersonID
sEmail = rs!PersonEmail

SendReport ( sWhere, sEmail )

rs.MoveNext
Loop

Set rs = Nothing
Set db = Nothing


The Send Report funciton will create the report, filtered by the Where clause, and send
it to the described email address. That's the piece you have already started, right?
 
T

TigerTom

Danny:

Thankyou for the feedback. It sounds like I may be on the right track. I
am attempting to use an ADO recordset to create the list of people to email.
My code is a little disjointed right now, because I have built different
functionality in different modules to simplify my testing.

The first piece of code I found on another forum and is what I am using to
send the email, calling a macro in outlook to actually do the send:

Option Explicit

' ACCESS VBA MODULE: Send E-mail without Security Warning
' (c) 2005 Wayne Phillips (http://www.everythingaccess.com)
' Written 07/05/2005
' Last updated v1.3 - 11/11/2005
'
' Please read the full tutorial & code here:
'
http://www.everythingaccess.com/tutorials.asp?ID=Outlook-Send-E-mail-without-Security-Warning
'
' Please leave the copyright notices in place - Thank you.

'This is a test function - replace the e-mail addresses with your own before
executing!!
'(CC/BCC can be blank strings, attachments string is optional)


'Global Declaration
Dim T As Long

Private Sub FnTestSafeSendEmail()
Dim blnSuccessful As Boolean
Dim strHTML As String

strHTML = "<html>" & _
"<body>" & _
"My <b><i>HTML</i></b> message text!" & _
"</body>" & _
"</html>"
blnSuccessful = FnSafeSendEmail("(e-mail address removed)", _
"My Message Subject", _
strHTML)

'A more complex example...
'blnSuccessful = FnSafeSendEmail("(e-mail address removed);
(e-mail address removed)", _
"My Message Subject", _
strHTML, _
"C:\MyAttachmentFile1.txt;
C:\MyAttachmentFile2.txt", _
"(e-mail address removed)", _
"(e-mail address removed)")
If blnSuccessful Then

MsgBox "E-mail message sent successfully!"

Else

MsgBox "Failed to send e-mail!"

End If

End Sub


'This is the procedure that calls the exposed Outlook VBA function...
'
Public Function FnSafeSendEmail(strTo As String, _
strSubject As String, _
strMessageBody As String, _
Optional strAttachmentPaths As String, _
Optional strCC As String, _
Optional strBCC As String) As Boolean

Dim objOutlook As Object ' Note: Must be late-binding.
Dim objNameSpace As Object
Dim objExplorer As Object
Dim blnSuccessful As Boolean
Dim blnNewInstance As Boolean

'Is an instance of Outlook already open that we can bind to?
On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
On Error GoTo 0

If objOutlook Is Nothing Then

'Outlook isn't already running - create a new instance...
Set objOutlook = CreateObject("Outlook.Application")
blnNewInstance = True
'We need to instantiate the Visual Basic environment... (messy)
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objExplorer = objOutlook.Explorers.Add(objNameSpace.Folders(1), 0)
objExplorer.CommandBars.FindControl(, 1695).Execute

objExplorer.Close

Set objNameSpace = Nothing
Set objExplorer = Nothing

End If

blnSuccessful = objOutlook.FnSendMailSafe(strTo, strCC, strBCC, _
strSubject, strMessageBody, _
strAttachmentPaths)

If blnNewInstance = True Then objOutlook.Quit
Set objOutlook = Nothing

FnSafeSendEmail = blnSuccessful

End Function


Now, this is the code where I am attempting to create the report for each
user. However, at the moment, I am just outputting the results to a message
box for debugging purposes, to make sure I am getting the data I expect.
That seems to be working fine:


Option Compare Database



Sub OpenSalesIdRecordset()

On Error Resume Next

Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim cmdSQL As ADODB.Command
Dim strDBName As String
Dim strConnectString As String
Dim strCursorType As String
Dim strLockType As String
Dim strDBNameAndPath As String
Dim strCurrentPath As String
Dim fso As New Scripting.FileSystemObject
Dim fil As Scripting.File
Dim strPrompt As String


'Create Connection To External Database
'
strCurrentPath = Application.CurrentProject.Path & "\"
strDBName = "IAStageDataBase1.accdb"
strDBNameAndPath = strCurrentPath & strDBName

'Attempt To Find DB, Display Error Message If Not Found
'
Set fil = fso.GetFile(strDBNameAndPath)
If fil Is Nothing Then
strPrompt = "Can't find " & strDBName
MsgBox strPrompt, vbCritical + vbOKOnly
GoTo ErrorHandlerExit
End If

On Error GoTo ErrorHandler

Set cnn = New ADODB.Connection
Set rst = New ADODB.Recordset

'Sepcify ACE 12.0 provider for Connecting to Access Database
'
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open strDBNameAndPath
strConnectString = .ConnectionString
End With

Set cmdSQL = New ADODB.Command
Set cmdSQL.ActiveConnection = cnn

strSQL = "SELECT DISTINCT a.[Sales Rep], b.[E-Mail] " _
& "FROM IASIProjectTbl a, IASIEmployeeTbl b " _
& "WHERE (a.[Sales Rep]=(b.[First Name]+ ' ' + b.[Last Name]) " _
& "And ((a.[Bid Due Date])<=(Date()+10) " _
& "And (a.[Bid Due Date])>=(Date())) " _
& "And ((a.[Project Status])='lead' " _
& "Or (a.[Project Status])='pricing'));"
cmdSQL.CommandText = strSQL
Set rst = cmdSQL.Execute

' Check Cursor and Lock type for the dataset
'
strCursorType = Switch(rst.CursorType = _
adOpenDynamic, _
"Dynamic (" & adOpenDynamic & ")", _
rst.CursorType = adOpenForwardOnly, _
"forward-only (" _
& adOpenForwardOnly & ")", _
rst.CursorType = adOpenKeyset, "Keyset (" _
& adOpenKeyset & ")", _
rst.CursorType = adOpenStatic, "Static (" _
& adOpenStatic & ")")

strLockType = Switch(rst.LockType = _
adLockOptimistic, _
"Optimistic (" & adLockOptimistic & ")", _
rst.LockType = adLockReadOnly, "Read-only (" _
& adLockReadOnly & ")", _
rst.LockType = adLockBatchOptimist, _
"BatchOptimistic (" _
& adLockBatchOptimistic & ")", _
rst.LockType = adLockPessimistic, _
"Pessimistic (" _
& adLockPessimistic & ")")

MsgBox "Recordset cursor/lock type: " _
& strCursorType & ", " & strLockType & vbCrLf

' Iterate through the dataset and print records
'
With rst
.MoveFirst
Do While Not .EOF
MsgBox "IASI Employee ID: " _
& ![Sales Rep] _
& vbCrLf & vbTab & "Employee E-Mail: " _
& ![E-Mail] _
& vbCrLf
rst.MoveNext
Loop
End With

' Error Handler
'
ErrorHandlerExit:

If Not rst Is Nothing Then
If rst.State = adStateOpen Then
rst.Close
Set rst = Nothing
End If
End If

If Not cnn Is Nothing Then
If cnn.State = adStateOpen Then
cnn.Close
Set cnn = Nothing
End If
End If

Exit Sub

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

End Sub


As I mentioned in my first post, I am a newbie to Access and VBA, so if you
have any other suggestions to improve efficiency, I am all ears. Thanks
again for your feedback.

--
TigerTom

Turning Small Business Data Into Information


Danny J. Lesandrini said:
Tom:

This might get deep pretty fast, but you're going to have to wrap your Send Report
code in a recordset cursor.

Can you post back the code that sends the report so I'll have some thing to work with?

Basically, what we'll do is to create a recordset of the people who should get the
report, grab the Key Field ID and output the reports one at a time, filtered for each
person. The recordset code will look like this ...


Dim db as DAO.Database
Dim rs As DAO.Recordset
Dim sSQL as String
Dim sWhere as String
Dim sEmail as String

sSQL = "SELECT PersonID, PersonEmail FROM tblPerson WHERE SendReport=True"
Set db = CurrentDb
Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)

Do Until rs.EOF
sWhere = "[PersonID]=" & rs!PersonID
sEmail = rs!PersonEmail

SendReport ( sWhere, sEmail )

rs.MoveNext
Loop

Set rs = Nothing
Set db = Nothing


The Send Report funciton will create the report, filtered by the Where clause, and send
it to the described email address. That's the piece you have already started, right?
 
D

Danny J. Lesandrini

Tom, why won't something this simple work?

1) Get a recordset of data to loop through
2) Open the report in design view (hidden)
3) Change its recordsource
4) Close and save the report
5) Use SendObject to send the report
(I send in Snapshot format below, but there are others)

I can tell you the downsides of this approch are the format choices and the security issues with sending email from code, but
neither of those are addressed in your code. You referenced something called SafeMail, but I don't see what's safe about it,
and in fact it's not clear to me that your code was complete.

This is simple and relatively elegant. A more complex example would include the Redemption library, which handles the security
issue, and another bit of code to output in PDF format (something I've never done but I believe is possible). For help with
the safe mail part, check out the Redemption site at http://www.dimastr.com/redemption/. For PDF conversion, someone else
will have to chime in. If neither of those are necessary, what's shown below should work out of the box.

Danny


' use ADO recordset here, if desired.
Dim db as DAO.Database
Dim rs As DAO.Recordset
Dim sSQL as String
Dim sWhere as String
Dim sEmail as String

sSQL = "SELECT PersonID, PersonEmail FROM tblPerson WHERE SendReport=True"
Set db = CurrentDb
Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)

Do Until rs.EOF
sWhere = "[PersonID]=" & rs!PersonID
sEmail = rs!PersonEmail

DoCmd.OpenReport "rptSales",acViewDesign,,,acHidden
Reports!rptSales.RecordSource = "SELECT * FROM qrySales " & sWhere
DoCmd.close acReport, "rptSales",acSaveYes

DoCmd.SendObject acSendReport,"rptSales",acFormatSNP,strTo, strCC, ,strSubject, strBody, False
SendReport ( sWhere, sEmail )

rs.MoveNext
Loop

Set rs = Nothing
Set db = Nothing
 
T

TigerTom

Danny -

Thank you! This looks like the perfect solution to my issue. Certainly
more simple and elegant than what I was working on. I will give this a try.
 
T

TigerTom

Danny - I was able to adapt this solution to my needs, and it works
perfectly! Thanks again for the assistance. - Tom
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top