Multiple emails with html body using two sql queries getting stuck 2

[diehippy]

Hi,

I was wondering if anyone would be so kind to have a look at my code and tell me where I am going wrong. My code has calls two queries the first populates the email add and the subject line and the other query fills the html template I have borrowed a template function to call it from an external source. it sends single emails (1st query) multiple rows in the html (2nd query). It all seems to work fine for the first email and then it just seem to get suck. I have looked everywhere in this forum and all over the internet to no avail.

Any help will be much appreciated

Many Thanks

Diehippy

P.S here is the code

Private Sub Command4_Click()
On Error Resume Next
Dim objOutlook As Object
Dim objEmail As Object
Dim MyDb As DAO.Database
Dim rsEmail As DAO.Recordset
Dim PER As DAO.Recordset
Dim sMessageBody, strCC
Dim apetext As Variant
Dim abdtext As Variant

Set MyDb = CurrentDb()

apetext = MyDb.QueryDefs("absence_parent_email_master").SQL

apetext = Replace(apetext, "@date", "'" & Me.AbsenceDate & "'")

MyDb.QueryDefs("absence_parent_email").SQL = apetext

Set rsEmail = MyDb.OpenRecordset("absence_parent_email", dbOpenSnapshot)



Set objOutlook = CreateObject("Outlook.application", "localhost")
Set objEmail = objOutlook.CreateItem(olMailItem)


sMessageBody = ReturnTemplate("ParentEmail")

abdtext = MyDb.QueryDefs("absence_per_day_master").SQL

abdtext = Replace(abdtext, "@date", "'" & Me.AbsenceDate & "'")

MyDb.QueryDefs("absence_per_day").SQL = abdtext

Set PER = MyDb.OpenRecordset("absence_per_day", dbOpenSnapshot)

'replace variables
sMessageBody = Replace(sMessageBody, "@FORENAME@", PER!FORENAME)
sMessageBody = Replace(sMessageBody, "@SURNAME@", PER!SURNAME)
sMessageBody = Replace(sMessageBody, "@PARENT_TITLE@", PER!PARENT_TITLE)
sMessageBody = Replace(sMessageBody, "@PARENT_FORENAME@", PER!PARENT_FORENAME)
sMessageBody = Replace(sMessageBody, "@PARENT_SURNAME@", PER!PARENT_SURNAME)
sMessageBody = Replace(sMessageBody, "@TIMESTAMP@", Format(Now(), "dddd, d mmmm yyyy at h:nn am/pm"))
sMessageBody = Replace(sMessageBody, "@REG_DATE@", PER!REG_DATE)
sMessageBody = Replace(sMessageBody, "@DAY@", PER!Day)
sMessageBody = Replace(sMessageBody, "@STARTTIME@", PER!STARTTIME)
sMessageBody = Replace(sMessageBody, "@ENDTIME@", PER!ENDTIME)
sMessageBody = Replace(sMessageBody, "@COURSETITLE@", PER!COURSETITLE)
sMessageBody = Replace(sMessageBody, "@REGMARKDESCR@", PER!REGMARKDESCR)

With rsEmail
With PER
.MoveFirst
.MoveFirst
Do Until rsEmail.EOF
Do Until PER.EOF


With objEmail
If IsNull(rsEmail!parent_email) = False Then
.To = rsEmail!parent_email
.SentOnBehalfOfName = "emailaddress"
.Subject = "Student Absence Notification - " & rsEmail!FORENAME & " " & rsEmail!SURNAME & " ID:" & rsEmail!person_code
.Importance = olImportanceHigh
.HTMLbody = sMessageBody
.display
'DoCmd.SendObject acSendNoObject, , , _
'sToName, , , sSubject, HTMLbody, False, False

End If
End With

.MoveNext
.MoveNext
Loop
Loop
End With
End With

Set MyDb = Nothing
Set rsEmail = Nothing
Set PER = Nothing
Set objOutlook = Nothing
Set objEmail = Nothing



End Sub

 

[traingamer]

You are only setting the objEmail object once - outside of your loop.

Set objEmail = objOutlook.CreateItem(olMailItem)

It appears that you should be setting it inside one of the loops.

Also, unless this is only part of your code, you aren't doing anything with PER except looping.

Greg
People demand freedom of speech as a compensation for the freedom of thought which they seldom use. Kierkegaard

 

[diehippy]

Thanks Traingamer,

been looking at the code for ages missed that simple point

PER is populating my html body of my email through a function call ReturnTemplate. Being quite new to vba, I would like to link the two queries together rsEmail and PER, both queries have a field that can be linked I would like to filter on PER query from the query rsEmail so I can bring through the correct data from PER as I loop through the email addresses in rsEmail

I hope this makes sense !

Cheers

Diehippy

 

[GComyn]

PER is used... .just not within the loops... the sMessageBody section should be within the PER loop so that it changes every time. the way it is, the message it the same for each email.

and you are right... the 'set objEmail' line probably should be inside the PER loop... probably right after the sMessageBody lines... and an 'set objEmail=nothing' before the .MoveNext for the PER loop.

GComyn

 

[diehippy]

Thanks for your Help GComyn,

It is most appreciated, I have changed my code to the following which done almost what I wanted it to do

Private Sub Command4_Click()
On Error Resume Next
Dim objOutlook As Object
Dim objEmail As Object
Dim MyDb As DAO.Database
Dim rsEmail As DAO.Recordset
Dim PER As DAO.Recordset
'Dim sToName As String
'Dim sSubject As String
Dim sMessageBody, strCC
'Dim sImportance As String
'Dim sSentOnBehalfOfName As String
Dim apetext As Variant
Dim abdtext As Variant

Set MyDb = CurrentDb()

apetext = MyDb.QueryDefs("absence_parent_email_master").SQL

apetext = Replace(apetext, "@date", "'" & Me.AbsenceDate & "'")

MyDb.QueryDefs("absence_parent_email").SQL = apetext

Set rsEmail = MyDb.OpenRecordset("absence_parent_email", dbOpenSnapshot)



Set objOutlook = CreateObject("Outlook.application")

abdtext = MyDb.QueryDefs("absence_per_day_master").SQL

abdtext = Replace(abdtext, "@date", "'" & Me.AbsenceDate & "'")

MyDb.QueryDefs("absence_per_day").SQL = abdtext

Set PER = MyDb.OpenRecordset("absence_per_day", dbOpenSnapshot)


With rsEmail
.MoveFirst
Do Until rsEmail.EOF

abdtext = MyDb.QueryDefs("absence_per_day_master").SQL

abdtext = Replace(abdtext, "@date", "'" & Me.AbsenceDate & "'")

abdtext = Replace(abdtext, "@person_code", rsEmail!person_code)

MyDb.QueryDefs("absence_per_day").SQL = abdtext

Set PER = MyDb.OpenRecordset("absence_per_day", dbOpenSnapshot)


Set objEmail = objOutlook.CreateItem(olMailItem)
sMessageBody = ReturnTemplate("ParentEmail")


'replace variables
sMessageBody = Replace(sMessageBody, "@FORENAME@", PER!FORENAME)
sMessageBody = Replace(sMessageBody, "@SURNAME@", PER!SURNAME)
sMessageBody = Replace(sMessageBody, "@PARENT_TITLE@", PER!PARENT_TITLE)
sMessageBody = Replace(sMessageBody, "@PARENT_FORENAME@", PER!PARENT_FORENAME)
sMessageBody = Replace(sMessageBody, "@PARENT_SURNAME@", PER!PARENT_SURNAME)
sMessageBody = Replace(sMessageBody, "@TIMESTAMP@", Format(Now(), "dddd, d mmmm yyyy at h:nn am/pm"))
sMessageBody = Replace(sMessageBody, "@REG_DATE@", PER!REG_DATE)
sMessageBody = Replace(sMessageBody, "@DAY@", PER!Day)
sMessageBody = Replace(sMessageBody, "@STARTTIME@", PER!STARTTIME)
sMessageBody = Replace(sMessageBody, "@ENDTIME@", PER!ENDTIME)
sMessageBody = Replace(sMessageBody, "@COURSETITLE@", PER!COURSETITLE)
sMessageBody = Replace(sMessageBody, "@REGMARKDESCR@", PER!REGMARKDESCR)
sMessageBody = Replace(sMessageBody, "@SONORDAUGHTER@", PER!SONORDAUGHTER)



With objEmail
If IsNull(rsEmail!parent_email) = False Then
.To = rsEmail!parent_email
.SentOnBehalfOfName = "An email Address"
.Subject = "Student Absence Notification - " & rsEmail!FORENAME & " " & rsEmail!SURNAME & " ID:" & rsEmail!person_code
.Importance = olImportanceHigh
.HTMLbody = sMessageBody
.display
'DoCmd.SendObject acSendNoObject, , , _
'sToName, , , sSubject, HTMLbody, False, False

End If
End With

Set objEmail = Nothing
Set PER = Nothing
.MoveNext
Loop
End With


Set MyDb = Nothing
Set rsEmail = Nothing

Set objOutlook = Nothing
Set objEmail = Nothing



End Sub


returnTemplate code is as follows

Public Function ReturnTemplate(sTemplate As String) As String

Dim fnum
Dim applicationPath As String
Dim filename As String
Dim InputText As String
Dim data As String

Select Case sTemplate
Case "ParentEmail"
filename = "parentemail.html"
End Select

If IsEmpty(filename) Then
MsgBox "Template cannot be found", vbExclamation + vbOKOnly, ""
Exit Function
End If


applicationPath = Application.CurrentProject.Path & "\templates\"

fnum = FreeFile()
Close fnum

Open applicationPath & filename For Input As fnum

While Not EOF(fnum)
Line Input #fnum, data

InputText = InputText & data & vbNewLine

Wend

Close #fnum

ReturnTemplate = InputText

End Function


The email is created and the correct information is put in the correct places except for a table in the html template. This table can have more than one line of data, depending on the PER query, but at the moment it is only showing the first line of data whether there is more than one line or not, If you could give some help on this bit I will be very grateful.

Many Thanks in Advance for your help

Diehippy