Loop only works once. Fails when setting .SQL code

[jkirkland]

I've reading through posts for a couple of days to figure out where I'm screwing up and can't figure it out.

This code borrows from several authors on the site (Thank you all) to send emails via Lotus Notes. It is suppose to open a query showing who will receive emails and for which department that person is to receive an email.

It then opens a temp table showing the records to be emailed which are listed for all departments.

The SQL statement is suppose to filter those records for just the department for which the person is assigned.

It fails on the line: qdf2.SQL = strSQL
and says Runtime error 91: Object variable or with block variable not set.

It sends the first email to the first person in the 1st table just fine but fails when its looping back through the second time.

Any help would be greatly appreciated and I apologize, I don't know how to insert code with the little white box to make it neat.

Sub EmailAssignments()

Dim strTo As String
Dim strSubject As String
Dim strBody As String
Dim strBodyLoop As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim SendString As String
Dim qdf As DAO.QueryDef
Dim qdf2 As DAO.QueryDef
Dim fld2 As DAO.Field
Dim strSQL As String
Dim afiles

Set db = CurrentDb

'1. Set list of people to receive emails and their department(from qryAssignBillEmail)

Set qdf = db.QueryDefs("qryAssignBillEmail")
Set rs = qdf.OpenRecordset


'2. Update MyBills temporary table using 3 action queries (Delete,Append,Append)
'(This is currently done on the Event Procedure behind the button on the Bill Assignment form
' because the procedure loops through the delete and action queries too quickly
' so the new process prompts the user to click ok to begin the next query)


'3. Set reference to the MyBills temporary table (through a query) that has the
'list of bills by dpt

Set qdf2 = CurrentDb.QueryDefs("qryTEMPMyBills")


'4. Email Verbage:
'A. Create Headers for the body of the email
strBodyLoop = StrConv(Trim([Forms]![frm_Leg_AssignBill]![txt_GMDPT]), 3) & vbCrLf
strBodyLoop = strBodyLoop & " " & vbCrLf
strBodyLoop = strBodyLoop & "BILL" & vbTab & vbTab & vbTab & "ASSIGNMENT DATE" & vbTab & vbTab & vbTab & "COMMENTS NEEDED" & vbCrLf
strBodyLoop = strBodyLoop & "============================================================================" & vbCrLf

'B. Create the Body of the email
'1) Create SQL for qryTEMPMyBills where the Dept equals the current record in tbl_GMDPT
'2) Add each bill as a new row and then a line under it(vbcrlf adds a new row in the email)

rs.MoveFirst
Do While Not rs.EOF

'a) SQL code for qryTEMPMyBills

Set fld2 = rs("[GMDPT]")

strSQL = "SELECT IIf([mybilltype]='A','X',Null) AS CommentsNeeded, "
strSQL = strSQL & "tblTEMPMyBills.MyBillsTempID, "
strSQL = strSQL & "tblTEMPMyBills.MyBillDept, "
strSQL = strSQL & "tblTEMPMyBills.BillID, "
strSQL = strSQL & "tblTEMPMyBills.BillIDLong, "
strSQL = strSQL & "tblTEMPMyBills.MyBill, "
strSQL = strSQL & "tblTEMPMyBills.Session, "
strSQL = strSQL & "tblTEMPMyBills.MyBillAssigned, "
strSQL = strSQL & "tblTEMPMyBills.MyBillType, "
strSQL = strSQL & "tblTEMPMyBills.LastMod "
strSQL = strSQL & "FROM tblTEMPMyBills "
strSQL = strSQL & "WHERE (((tblTEMPMyBills.MyBillDept)=" & [fld2] & "))"

qdf2.SQL = strSQL

'b) Body of email where each bill for that dept is its own row

Set rs2 = qdf2.OpenRecordset

rs2.MoveFirst
Do While Not rs2.EOF

If Len(rs2.Fields("MyBill")) < 7 Then 'Fixes extra tabbing if bill number is > 6 characters
strBodyLoop = strBodyLoop & rs2.Fields("MyBill") & vbTab & vbTab & vbTab & Format(rs2.Fields("MyBillAssigned"), "mm/dd/yy" & " at " & "hh:mm am/pm") & vbTab & vbTab & vbTab & rs2("commentsneeded") & vbCrLf
Else
strBodyLoop = strBodyLoop & rs2.Fields("MyBill") & vbTab & vbTab & Format(rs2.Fields("MyBillAssigned"), "mm/dd/yy" & " at " & "hh:mm am/pm") & vbTab & vbTab & vbTab & rs2("commentsneeded") & vbCrLf
End If

strBodyLoop = strBodyLoop & "-------------------------------------------------------------------------------------------------------------------------------------" & vbCrLf

Set qdf2 = Nothing

rs2.MoveNext

Loop

Debug.Print strBodyLoop ' print to the immediate window

rs2.Close

'4. Loops through the query results and sends an email, then it loops back through
' and sends the same email to the next recipient

SendString = ""
SendString = SendString & rs("RepEmail")

strTo = SendString
strSubject = "Legislative Bill Assignments: As of " & Format(Now(), "m/d/yy")
strBody = strBodyLoop

SendNotesMail strTo, strSubject, strBody

rs.MoveNext

Loop

rs.Close


'5. Cleanup
Set rs = Nothing
Set rs2 = Nothing

End Sub

 

[RoyVidar]

Sometimes the amount of comments makes it a bit difficult to see the code;-)

What I guess is the culprit here, is that you set qdf2 prior to the main loop, then set it to nothing within the inner loop, so it is not set when you attempt to assign a new SQL statement to it.

I'm not very versed in DAO, but I think I'd tried either not releasing the qdf2 object within the inner loop, and if that doesn't do it, then release it as you do now, and instantiate the qdf2 just prior to assigning the SQL statement (at the top of the outer/main loop).

Roy-Vidar

 

[jkirkland]

You were correct about clearing out the qdf2 too soon. I fixed it and a couple of other things and it works fine now. Also, thanks for the tip about the comments. I cleaned them up as well to make it more readable.

If anyone is looking to send query results as text in a Lotus Notes (or any other email program if you modify the code) this works for me.

Dim strTo As String
Dim strSubject As String
Dim strBody As String
Dim strBodyLoop As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim SendString As String
Dim qdf As DAO.QueryDef
Dim qdf2 As DAO.QueryDef
Dim fld As DAO.Field
Dim strSQL As String
Dim strSQLEnd As String
Dim afiles

Set db = CurrentDb
'***********************************
'OUTER LOOP BEGINS
'***********************************
Set qdf = db.QueryDefs("qryAssignBillEmail")
Set rs = qdf.OpenRecordset

rs.MoveFirst
Do While Not rs.EOF
Set fld = rs("[GMDPT]")
Set qdf2 = CurrentDb.QueryDefs("qryTEMPMyBills")

strSQL = "SELECT IIf([mybilltype]='A','X',Null) AS CommentsNeeded, "
strSQL = strSQL & "tblTEMPMyBills.MyBillsTempID, "
strSQL = strSQL & "tblTEMPMyBills.MyBillDept, "
strSQL = strSQL & "tblTEMPMyBills.BillID, "
strSQL = strSQL & "tblTEMPMyBills.BillIDLong, "
strSQL = strSQL & "tblTEMPMyBills.MyBill, "
strSQL = strSQL & "tblTEMPMyBills.Session, "
strSQL = strSQL & "tblTEMPMyBills.MyBillAssigned, "
strSQL = strSQL & "tblTEMPMyBills.MyBillType, "
strSQL = strSQL & "tblTEMPMyBills.LastMod "
strSQL = strSQL & "FROM tblTEMPMyBills "
strSQL = strSQL & "WHERE (((tblTEMPMyBills.MyBillDept)=" & [fld] & "))"

qdf2.SQL = strSQL
'---------------------------------------------------------------------------------------
'INNER LOOP BEGINS
'---------------------------------------------------------------------------------------
Set rs2 = qdf2.OpenRecordset

'Email Header
strBodyLoop = strBodyLoop & "BILL" & vbTab & vbTab & vbTab & "ASSIGNMENT DATE" & vbTab & vbTab & vbTab & "COMMENTS NEEDED" & vbCrLf
strBodyLoop = strBodyLoop & "============================================================================" & vbCrLf

'Email Body - List of bills for the sendee's department
rs2.MoveFirst
Do While Not rs2.EOF
If Len(rs2.Fields("MyBill")) < 7 Then 'Fixes extra tabbing if bill number is > 6 characters
strBodyLoop = strBodyLoop & rs2.Fields("MyBill") & vbTab & vbTab & vbTab & Format(rs2.Fields("MyBillAssigned"), "mm/dd/yy" & " at " & "hh:mm am/pm") & vbTab & vbTab & vbTab & rs2("commentsneeded") & vbCrLf
Else
strBodyLoop = strBodyLoop & rs2.Fields("MyBill") & vbTab & vbTab & Format(rs2.Fields("MyBillAssigned"), "mm/dd/yy" & " at " & "hh:mm am/pm") & vbTab & vbTab & vbTab & rs2("commentsneeded") & vbCrLf
End If
strBodyLoop = strBodyLoop & "-------------------------------------------------------------------------------------------------------------------------------------" & vbCrLf
Set qdf2 = Nothing
rs2.MoveNext
Loop

Debug.Print strBodyLoop ' print to the immediate window

rs2.Close
'---------------------------------------------------------------------------------------
'INNER LOOP ENDS
'---------------------------------------------------------------------------------------

SendString = ""
SendString = SendString & rs("RepEmail")

strTo = SendString
strSubject = "Legislative Bill Assignments: As of " & Format(Now(), "m/d/yy") & " " & fld
strBody = strBodyLoop

SendNotesMail strTo, strSubject, strBody

rs.MoveNext
strBodyLoop = ""
Set qdf = Nothing
Set qdf2 = Nothing
Set fld = Nothing
Loop
'***********************************
'OUTER LOOP ENDS
'***********************************

rs.Close

Set rs = Nothing
Set rs2 = Nothing

End Sub

 

[RoyVidar]

No, no - don't take it as an advice to reduce comments in the code, it's just that because of the comments, I found it a bit hard to read the flow of the code in the initial post. Comments are encouraged by most, even me...

Roy-Vidar