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?
