Hi Marsh/Sue,
Nice to know that RecordCount = 0 is reliable.
I thought that, if Sue is using a Crosstab query, it might
not produce usable records and would be worth checking.
Apologies for not knowing that SendObject does not permit a
criterion argument.
I ran some tests, with two interesting results.
1. SendObject appears not to work as stated in help.
In Access Help, the "SendObject Action" topic states that,
if the "Edit Message" argument is set to Yes, you can edit
the email; whereas, if the argument is set to No, the email
is sent automatically. Help says the default is No. As Sue
does not use this argument, the default of No should apply,
thereby sending the email immediately. However, I found
that, by not using the "Edit Message" argument, Microsoft
Outlook pauses, allowing the user to edit the email. This
seems to imply that the default for this argument is Yes.
Also, I found that if the "Edit Message" argument is set to
No (so the message is sent immediately), Microsoft Outlook
security intervenes with a warning to the effect that a
program is attempting to send a message. As a result,
security enforces a 15 second pause, which might be
inconvenient; it might be better to allow editing and click
the Send button.
2. Marsh, your method of using a filter appears not to work
for the reasons you cite. I found that there appears to be
insufficient time for Access to apply the filter before
SendObject sends the report. As a result, when your method
is run at full speed, all emails have an attached report
that contains all records, not just the filtered record.
The good news is that it appears that SendObject finishes
its work before returning control to VBA. Therefore, it is
possible (as you suggested) to enhance Sue's method by
closing the report at the end of the loop to produce a
workable solution.
Here are the two tests I ran:
Private Sub Email_RPT_to_All_Emp_Click_1()
' Marsh's filter method.
'
' This method works when the code is
' stepped through, but does not work
' at full speed.
Const strcReportName As String = _
"All Emp Time"
Dim rst As DAO.Recordset
Dim lngEmpID As Long
Dim strTo As String
Dim objRPT As Access.Report
On Error GoTo Error_Email_RPT_to_All_Emp_Click_1
DoCmd.OpenReport strcReportName, acViewPreview
Set rst = CurrentDb.OpenRecordset( _
"All EmpTimeToDate_Crosstab")
If rst.RecordCount = 0 Then
MsgBox "No Reports to email.", vbInformation
Else
Do Until rst.EOF
lngEmpID = rst!EmployeeID
strTo = rst!EmailAddress
Reports(strcReportName).Filter = _
"EmployeeID=" & lngEmpID
Reports(strcReportName).FilterOn = True
DoCmd.SendObject acSendReport, strcReportName, _
acFormatSNP, strTo, , , "Monthly Time", _
"Attached is your monthly time"
rst.MoveNext
Loop
End If
MsgBox "Done sending Employee Time email. ", _
vbInformation, "Done"
Exit_Email_RPT_to_All_Emp_Click_1:
For Each objRPT In Access.Reports
If objRPT.Name = strcReportName Then
DoCmd.Close acReport, strcReportName, _
acSaveNo
Exit For
End If
Next
If Not rst Is Nothing Then
rst.Close
Set rst = Nothing
End If
Exit Sub
Error_Email_RPT_to_All_Emp_Click_1:
Select Case Err.Number
Case 2501
MsgBox "User cancelled sending email " _
& "for EmployeeID = " & lngEmpID
Resume Next
Case Else
MsgBox "Error (" & CStr(Err.Number) & ") " _
& Err.Description, vbExclamation, "Error!"
Resume Exit_Email_RPT_to_All_Emp_Click_1
End Select
End Sub
Private Sub Email_RPT_to_All_Emp_Click_2()
' Sue's method, enhanced with Close Report
' at end of loop.
' This method works a full speed.
Const strcReportName As String = _
"All Emp Time"
Dim rst As DAO.Recordset
Dim lngEmpID As Long
Dim strTo As String
Dim objRPT As Access.Report
On Error GoTo Error_Email_RPT_to_All_Emp_Click_2
Set rst = CurrentDb.OpenRecordset( _
"All EmpTimeToDate_Crosstab")
If rst.RecordCount = 0 Then
MsgBox "No Reports to email.", vbInformation
Else
Do Until rst.EOF
lngEmpID = rst!EmployeeID
strTo = rst!EmailAddress
DoCmd.OpenReport strcReportName, acViewPreview, _
, "[EmployeeID] = " & lngEmpID
DoCmd.SendObject acSendReport, strcReportName, _
acFormatSNP, strTo, , , "Monthly Time", _
"Attached is your monthly time"
DoCmd.Close acReport, strcReportName, acSaveNo
rst.MoveNext
Loop
End If
MsgBox "Done sending Employee Time email. ", _
vbInformation, "Done"
Exit_Email_RPT_to_All_Emp_Click_2:
For Each objRPT In Access.Reports
If objRPT.Name = strcReportName Then
DoCmd.Close acReport, strcReportName, _
acSaveNo
Exit For
End If
Next
If Not rst Is Nothing Then
rst.Close
Set rst = Nothing
End If
Exit Sub
Error_Email_RPT_to_All_Emp_Click_2:
Select Case Err.Number
Case 2501
MsgBox "User cancelled sending email " _
& "for EmployeeID = " & lngEmpID
Resume
Case Else
MsgBox "Error (" & CStr(Err.Number) & ") " _
& Err.Description, vbExclamation, "Error!"
Resume Exit_Email_RPT_to_All_Emp_Click_2
End Select
End Sub
Regards
Geoff.
Marshall Barton said:
sue said:
Thanks for all the help. I am trying really hard to learn
how to code, but
still need a ton of help. I have changed alot of he code
using suggestions
from here. I've come a long way, but I still can't get
the results I want.
The problem I have now is the report will attach to the
email, but it will
either be blank or wil include everyone. Any help is
greatly appreciated.
Option Explicit
Option Compare Database
Private Sub Email_RPT_to_All_Emp_Click()
On Error GoTo Some_Err
Dim rst As DAO.Recordset
Dim strempid As Long
Dim strTo As String
Set rst = CurrentDb.OpenRecordset("All
EmpTimeToDate_Crosstab")
If rst.RecordCount = 0 Then
MsgBox "No Reports to email.", vbInformation
Else
rst.MoveFirst
Do Until rst.EOF
strempid = rst!EmployeeID
strTo = rst!EmailAddress
DoCmd.OpenReport "All Emp Time", acViewPreview, ,
"[EmployeeID] =
strempid"
DoCmd.SendObject acSendReport, "All Emp Time",
acFormatSNP, strTo, ,
, "Monthly Time", "Attached is your monthly time"
rst.MoveNext
Loop
End If
rst.Close
Set rst = Nothing
MsgBox "Done sending Employee Time email. ",
vbInformation, "Done"
Exit Sub
Some_Err:
MsgBox "Error (" & CStr(Err.Number) & ") " &
Err.Description, _
vbExclamation, "Error!"
End Sub
First, you do not need to use the MoveLast and MoveFirst,
because a freshly opened record set will always be
positioned at the first record. The record count will
either be a 0 if there are no records or >0 if there is
one
or more records.
I think you should test the query separately to make sure
it
works before getting involved in all the code. Once the
query runs successfully, then it should open in your code,
BUT your whole idea may not be valid even after you fix
the
OpenReport line to be:
DoCmd.OpenReport "All Emp Time", acViewPreview, ,
"EmployeeID = " & strempid
The problem is that the report and your VBA code run
asynchronously with the VBA code having a higher priority.
That means that your code goes around the loop and tries
to
run the next report before the current report has been
processed. A second attempt to open an already open
report
will produce unpredictable results so you must code the
loop
to wait for one report to finish before trying to open the
next one.
I have no experience using SendObject, but, if SendObject
is
synchronous (i.e. completes its job before returning to
your
code), then you would not need to use some yucky code to
wait, but you definitely would need to close the report
after the SendObject line.
Before doing it that way, I think(?) I would first try
moving the OpenReport outside the loop and just set the
report's Filter property inside the loop. This would
restart the report with the new filter but avoid closing
and
re-opening the report.
DoCmd.OpenReport "All Emp Time", acViewPreview
Set rst = CurrentDb.OpenRecordset("All
EmpTimeToDate_Crosstab")
If rst.RecordCount = 0 Then
MsgBox "No Reports to email.", vbInformation
Else
Do Until rst.EOF
strempid = rst!EmployeeID
strTo = rst!EmailAddress
Reports("All Emp Time").Filter = "[mployeeID=" &
strempid
Reports("All Emp Time").FilterOn = True
DoCmd.SendObject ......
rst.MoveNext
Loop
DoCmd.Close acReport, "All Emp Time", acSaveNo
End If
All this is pretty advanced stuff dealling with some
subtle
and complex issues, but I believe it is necessitated by
your
need to send the same report multiple times with different
data.
