Loop thru Numbers in Table and E-mail Report

[foxhound]

Can anyone tell me why this works when there is only one record in my supervisors table but doesn't when there is more than one record?

Sub SeparateEmails()
'*** error trapping - execution goes to bottom on error
'On Error GoTo Err_SeparateEmails

Dim db As Database
Dim qdf As QueryDef
Dim strSQL As String
Dim rsGLTable As Recordset
Dim rsCriteria As DAO.Recordset
Dim rst As Recordset

Set db = CurrentDb
Set rsCriteria = db.OpenRecordset("SELECT distinct [snum],[semail] FROM Supervisors")

'*** the first record in the Supervisors table ***
With rsCriteria
.MoveFirst
' With rs
' If .EOF Then
' Exit Sub
' Else
End With
'*** loop to move through the records in Supervisors table
Do Until rsCriteria.EOF
'*** create the Select query based on
' the first record in the Supervisors table
strSQL = "SELECT * FROM GLTable WHERE "
strSQL = strSQL & "[snum] = '" & rsCriteria![SNUM] & "'"
'MsgBox strSQL
'*** delete the previous query
db.QueryDefs.Delete "NewQuery"
Set qdf = db.CreateQueryDef("NewQuery", strSQL)
'
DoCmd.SendObject acReport, "rptGLTable", "RichTextFormat(*.rtf)", rsCriteria![semail], , , "Your Report", "Here is this week's report.", , ""

' *** goto the next record in Supervisors table
ContinueToNext:
rsCriteria.MoveNext

Loop

rsCriteria.Close
'
Exit_SeparateEmails:
Exit Sub

Err_SeparateEmails: '*** if there is an error, execution goes here
'*** if the error is the table or query missing (3265)
' then skip the delete line and resume on the next line
' Error 2501 notifies you that the SendObject action
' has been cancelled. See the OnNoData Event of the report.
If Err.Number = 3265 Or Err.Number = 2501 Then
Resume ContinueToNext
Else
'*** write out the error and exit the sub
MsgBox Err.Description
Resume Exit_SeparateEmails
End If

End Sub

 

[Russell Hauf]

You say it doesn't work with more than one - what does happen when you try to run it with more than one record?

 

[foxhound]

Hey Russell,

Okay, I corrupted my file and am recreating from an earlier backup. But basically, here is what I am trying to accomplish:

Table: Supervisors
Fields: empno, email, snum

Table: GlTable
Fields: empno, Multiple data columns

Report: RptGlTable
Text boxes: empno, Snum, Multiple data boxes

I need to Select distinct snum from supervisors and select the email and empno fields for that snum record

Go to first record of this selection

query all records from Gltable based on the empno of the 1st record above
then filter the RptGlTable based upon that query and send rptGlTable as richtextformat(.rtf) to snum

loop until .eof then exit

I think in my earlier code, I was not selecting unique snum's and this was creating a conflict. Any suggestions?

 

[Russell Hauf]

Without knowing your data, I'd still like to know what happens when you run the code above...

 

[mdmilner]

I'm going to venture a guess. I encountered a problem myself under Win2K and Office2K where the DoCmd.SendObject command had a problem handling more than one email attempt. The code would cycle thru the entire table, but only the first would actually generate an email.

The fix was to patch up to SR3

I'd also like to recommend using something like this to test to see if the table/query already exists in the database before attempting to read/delete it.

http://www.mvps.org/access/modules/mdl0014.htm

I don't think you need the .MoveFirst at all. If you need a specific order, you could always change the SQL for rsCriteria to include a sort.

Mike

 

[foxhound]

Thanks Mike. I'll give it a try