Email custom report to individual addresses

H

HMarcks

New member
Local time
Today, 05:03
Joined
Jul 23, 2014
Messages
7
Good morning everyone,

I haven't posted in awhile but am always browsing the information. Unfortunately I have been stuck for a few days on this one and I swear I had it working in a different application at one time.

Working with Access 2007 and am knowledgeable enough to mess around with everyone else's codes trying to get them to work for me but don't have the understanding yet to write my own stuff.

So I am trying to attach a pdf of a report to an email and send it through outlook. I am using a filter and loop to pull out the correct report record and email address for each record. I have been able to loop through the different email address and attaché a single report record (as opposed to a continuous report with all the records) but it does not keep filtering the report correctly. Every email address gets the same first page of the report instead of the correctly filtered one. So I think my problem is on looping the form through the records so the report re-opens with a new record.

OK here is the code stuff:
Report Rpt_TBB2016-17_ResAppAcceptance with record source query TBB2016-17_AppLtr_Res
Code: 
Private Sub Report_Open(Cancel As Integer)
Me.Filter = "AcctNum=" & Forms![TBB2016-17_Email]![AcctNum]
Me.FilterOn = True

End Sub
Form TBB2016-17_Email with record source query TBB2016-17_AppLtr_Res and button for Emailing
Code: 
Option Compare Database
Private Sub EMailAccLtr_Click()

Dim MyDB As DAO.Database, rs As DAO.Recordset
Dim strBody As String, lngCount As Long, lngRSCount As Long

Set MyDB = DBEngine.Workspaces(0).Databases(0)
Set rs = MyDB.OpenRecordset("TBB2016-17_AppLtr_Res")
rs.MoveLast
rs.MoveFirst

Do Until rs.EOF
StrTo = rs!TurfEmail
DoCmd.SendObject acSendReport, "Rpt_TBB2016-17_ResAppAcceptance", acFormatPDF, StrTo, "", "", "TBB 2016-17 Acceptance HEADER HERE", "BODY HERE", False
rs.MoveNext
Loop

rs.Close
MyDB.Close
Set rs = Nothing
Set MyDB = Nothing
Close
End Sub
Can anyone tell what I am doing wrong to make it not loop through the report records?
 
Within your loop I'd expect you to update

Forms![TBB2016-17_Email]![AcctNum]

with the current account number. As is, it never changes so you get the same one.
 
Hi Paul, I have been digging through a lot of your posts where you have tried to help others with very similar issues. Sorry I haven't been able to decipher it all on my own and thank you for helping me.

I thought the MoveNext was supposed to make the form go to the next record and therefore update the AcctNum field?

This seems to be confusing it trying to change the record instead of just using the next one
Code: 
Private Sub EMailAccLtr_Click()
    
    Dim MyDB As DAO.Database, rs As DAO.Recordset
    
    Set MyDB = DBEngine.Workspaces(0).Databases(0)
     Set rs = MyDB.OpenRecordset("TBB2016-17_AppLtr_Res")
       rs.MoveLast
      rs.MoveFirst
      
Do Until rs.EOF
     StrTo = rs!TurfEmail
     DoCmd.SendObject acSendReport, "Rpt_TBB2016-17_ResAppAcceptance", acFormatPDF, StrTo, "", "", "TBB 2016-17 Acceptance HEADER HERE", "BODY HERE", False
     rs.MoveNext
    
    Forms![TBB2016-17_Email]![AcctNum] = rs!AcctNum
Loop
 
    rs.Close
    MyDB.Close
    Set rs = Nothing
    Set MyDB = Nothing
    Close
 End Sub
 
ok so I added this
Code: 
DoCmd.GoToRecord , , acNext
between the SendObject and the MoveNext and it worked! but was that what you meant for me to do? it seems like I am doing something redundant. It also jumps to a blank record at the end which may throw some of the users off but I guess I can leave it sense it works now.

Code: 
Private Sub EMailAccLtr_Click()
    
    Dim MyDB As DAO.Database, rs As DAO.Recordset
    
    Set MyDB = DBEngine.Workspaces(0).Databases(0)
     Set rs = MyDB.OpenRecordset("TBB2016-17_AppLtr_Res")
       rs.MoveLast
      rs.MoveFirst
      
Do Until rs.EOF
    StrTo = rs!TurfEmail
    DoCmd.SendObject acSendReport, "Rpt_TBB2016-17_ResAppAcceptance", acFormatPDF, StrTo, "", "", "TBB 2016-17 Acceptance HEADER HERE", "BODY HERE", False
     
    DoCmd.GoToRecord , , acNext
    rs.MoveNext
Loop
     rs.Close
    MyDB.Close
    Set rs = Nothing
    Set MyDB = Nothing
    Close
 End Sub
 
The MoveNext makes the recordset move to the next record, not the form. I was thinking more of your first effort, setting the textbox value, but I would have been using an unbound textbox, not the record on the form. Glad you got it to work.
 
OK that makes sense I knew it was something wrong with he form moving to the next record because I never saw it change records. Thank you for helping me find a way to fix it.
 
No problem. I guess the confusion arises from the fact that I wouldn't use a bound form for this. I'd use it if I was going to send a report just for the record displayed on the form. For this situation of sending individualized reports to different recipients, I would have used an unbound textbox on a form or a variable, and not worried about having to move the form to each record.
 
Got it! unbound text box starts out with no record then when I run the code it will populate it and in turn populate the report!

Code: 
Private Sub EMailAccLtr_Click()
    
    Dim MyDB As DAO.Database, rs As DAO.Recordset
    
    Set MyDB = DBEngine.Workspaces(0).Databases(0)
     Set rs = MyDB.OpenRecordset("TBB2016-17_AppLtr_Res")
       rs.MoveLast
      rs.MoveFirst
      
Do Until rs.EOF
    Forms![TBB2016-17_Email]![AcctNum] = rs!AcctNum
    StrTo = rs!TurfEmail
    DoCmd.SendObject acSendReport, "Rpt_TBB2016-17_ResAppAcceptance", acFormatPDF, StrTo, "", "", "TBB 2016-17 Acceptance HEADER HERE", "BODY HERE", False
    rs.MoveNext
    
Loop
     rs.Close
    MyDB.Close
    Set rs = Nothing
    Set MyDB = Nothing
    Close
 End Sub

Thank you!!!
 
Exactly! Not saying it's "wrong" to do it the other way, just not how I would do it.
 
I ran into another problem with this. I added to the code so I could send out different letter types under specific circumstances. Now if the first instance has no record sets it is getting stopped on the first rs.MoveLast. If there are no record sets in any of the options I need it to skip down to the next letter option. Any idea on this one? do I need to do some If Not (rs.BOF And rs.EOF) Then stuff? and if that is the case how do I tell it in the "then" part to move to another section of the code?

Code: 
Private Sub EMailAccLtr_Click()
'Update deadline dates
' Accepted Residential
Dim MyDB As DAO.Database, rs As DAO.Recordset
Set MyDB = DBEngine.Workspaces(0).Databases(0)
Set rs = MyDB.OpenRecordset("Qry_TBB2016-17_AppLtr_Res_Accepted")
[/FONT][/COLOR][COLOR=red][FONT=Verdana]rs.MoveLast[/FONT][/COLOR][COLOR=black][FONT=Verdana]
rs.MoveFirst
Do Until rs.EOF
Forms![Frm_TBB2016-17_Email]![AcctNum] = rs!AcctNum
StrTo = rs!TurfEmail
DoCmd.SendObject acSendReport, "Rpt_TBB2016-17_ResAppAcceptance", acFormatPDF, StrTo, "", "", "XYZ Turf Buy Back Grant Application Accepted", "Please see attached regarding your XYZ turf buy back application.", False
rs.MoveNext
Loop
rs.Close
MyDB.Close
Set rs = Nothing
Set MyDB = Nothing
Close
' Rejected Residential
Set MyDB = DBEngine.Workspaces(0).Databases(0)
Set rs = MyDB.OpenRecordset("Qry_TBB2016-17_AppLtr_Res_Rejected")
Do Until rs.EOF
Forms![Frm_TBB2016-17_Email]![AcctNum] = rs!AcctNum
StrTo = rs!TurfEmail
DoCmd.SendObject acSendReport, "Rpt_TBB2016-17_ResAppRejected", acFormatPDF, StrTo, "", "", "XYZ Turf Buy Back Grant Application Notice", "Please see attached regarding your XYZ turf buy back application.", False
rs.MoveNext
Loop
rs.Close
MyDB.Close
Set rs = Nothing
Set MyDB = Nothing
Close

' Accepted Large Scale
Set MyDB = DBEngine.Workspaces(0).Databases(0)
Set rs = MyDB.OpenRecordset("Qry_TBB2016-17_AppLtr_LS_Accepted")
Do Until rs.EOF
Forms![Frm_TBB2016-17_Email]![AcctNum] = rs!AcctNum
StrTo = rs!TurfEmail
DoCmd.SendObject acSendReport, "Rpt_TBB2016-17_LSAppAcceptance", acFormatPDF, StrTo, "", "", "XYZ Turf Buy Back Grant Application Accepted", "Please see attached regarding your XYZ turf buy back application.", False
rs.MoveNext
Loop
rs.Close
MyDB.Close
Set rs = Nothing
Set MyDB = Nothing
Close
' Rejected Large Scale
Set MyDB = DBEngine.Workspaces(0).Databases(0)
Set rs = MyDB.OpenRecordset("Qry_TBB2016-17_AppLtr_LS_Rejected")
Do Until rs.EOF
Forms![Frm_TBB2016-17_Email]![AcctNum] = rs!AcctNum
StrTo = rs!TurfEmail
DoCmd.SendObject acSendReport, "Rpt_TBB2016-17_LSAppRejected", acFormatPDF, StrTo, "", "", "XYZ Turf Buy Back Grant Application Notice", "Please see attached regarding your XYZ turf buy back application.", False
rs.MoveNext
Loop
rs.Close
MyDB.Close
Set rs = Nothing
Set MyDB = Nothing
Close

' Accepted Partial Large Scale
Set MyDB = DBEngine.Workspaces(0).Databases(0)
Set rs = MyDB.OpenRecordset("Qry_TBB2016-17_AppLtr_LS_PartialAcceptance")
Do Until rs.EOF
Forms![Frm_TBB2016-17_Email]![AcctNum] = rs!AcctNum
StrTo = rs!TurfEmail
DoCmd.SendObject acSendReport, "Rpt_TBB2016-17_LSAppPARTAcceptance", acFormatPDF, StrTo, "", "", "XYZ Turf Buy Back Grant Application Notice", "Please see attached regarding your XYZ turf buy back application.", False
rs.MoveNext
Loop
rs.Close
MyDB.Close
Set rs = Nothing
Set MyDB = Nothing
Close
End Sub[/FONT][/COLOR]
 
I never include these, as the recordset always starts on the first record in my experience:

rs.MoveLast
rs.MoveFirst

I just loop with:

Do While Not rs.EOF

If there are no records, the loop will be skipped.
 
Of course I am getting some type of corruption problem now...:banghead: It would be so nice if I had the time and resources to start all over with his database.
 
You must log in or register to reply here.

Similar threads

N
Solved MS Access Outlook VBA fixing
Replies
5
Views
208
nector
N
B
Solved Error 6 Overflow
2
Replies
26
Views
1,176
Gasman
Gasman
M
Solved Update records through a recordset
Replies
11
Views
914
Pat Hartman
P
B
Run Reports using VBA or Local table
Replies
13
Views
562
Pat Hartman
P
oxicottin
Solved Out Of Memory error when emailing
Replies
8
Views
761
oxicottin
oxicottin

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom