Update Third Table While Looping Through Two Recordsets - vba

Question

I have the following code (which a very helpful person on here wrote based on a previous question). It loops through two tables to determine if an interview is valid and then loops though a gift card table for an unused card. This all works as expected. However, I now realize I need to add a new record to a third table (Receipts) everytime a card is assigned. I have tried using "INSERT INTO..." in the loop but it never puts anything into the Receipts table. The data going to the Receipts table will need to selected from both the Interviews table and the Giftcards table.
On Error GoTo E_Handle
Dim db As DAO.Database
Dim rsInterview As DAO.Recordset
Dim rsGiftcard As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb
strSQL = "SELECT * FROM [SOR 2 UNPAID Intake Interviews]" _
& " WHERE InterviewTypeId='1' " _
& " AND ConductedInterview=1 " _
& " AND StatusId IN(2,4,5,8)" _
& " AND IsIntakeConducted='1' " _
& " ORDER BY InterviewDate ASC;"
Set rsInterview = db.OpenRecordset(strSQL)
If Not (rsInterview.BOF And rsInterview.EOF) Then
strSQL = "SELECT * FROM Giftcard_Inventory_Query" _
& " WHERE CardType=1 " _
& " AND Assigned=0 " _
& " AND Project=3 " _
& " ORDER BY DateAdded ASC, CompleteCardNumber ASC;"
Set rsGiftcard = db.OpenRecordset(strSQL)
If Not (rsGiftcard.BOF And rsGiftcard.EOF) Then
Do
rsGiftcard.Edit
rsGiftcard!DateUsed = Format(Now(), "mm/dd/yyyy")
rsGiftcard!Assigned = "1"
rsGiftcard.Update
db.Execute " INSERT INTO [SOR 2 Intake Receipts] " _
& "(PatientID,GiftCardType,GiftCardNumber,GiftCardMailedDate,InterviewDate,CreatedBy,GpraCollectorID) VALUES " _
& "(rsInterview!PatientID, rsGiftcard!CardType, rsGiftcard!CompleteCardNumber, Now(), rsInterview!InterviewDate, rsInterview!CreatedBy, rsInterview!GpraCollectorID);"
rsGiftcard.MoveNext
rsInterview.MoveNext
Loop Until rsInterview.EOF
End If
End If
sExit:
On Error Resume Next
rsInterview.Close
rsGiftcard.Close
Set rsInterview = Nothing
Set rsGiftcard = Nothing
Set db = Nothing
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "sAssignGiftCards", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit

Answer 1

I figured it out. Thanks to everyone who pushed me in the correct direction.
On Error GoTo E_Handle
Dim db As DAO.Database
Dim rsInterview As DAO.Recordset
Dim rsGiftcard As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb
strSQL = "SELECT * FROM [SOR 2 UNPAID Intake Interviews]" _
& " WHERE InterviewTypeId='1' " _
& " AND ConductedInterview=1 " _
& " AND StatusId IN(2,4,5,8)" _
& " AND IsIntakeConducted='1' " _
& " ORDER BY InterviewDate ASC;"
Set rsInterview = db.OpenRecordset(strSQL)
If Not (rsInterview.BOF And rsInterview.EOF) Then
strSQL = "SELECT * FROM Giftcard_Inventory_Query" _
& " WHERE CardType=1 " _
& " AND Assigned=0 " _
& " AND Project=3 " _
& " ORDER BY DateAdded ASC, CompleteCardNumber ASC;"
Set rsGiftcard = db.OpenRecordset(strSQL)
If Not (rsGiftcard.BOF And rsGiftcard.EOF) Then
Do
rsGiftcard.Edit
rsGiftcard!DateUsed = Format(Now(), "mm/dd/yyyy")
rsGiftcard!Assigned = "1"
rsGiftcard.Update
db.Execute " INSERT INTO [SOR 2 Intake Receipts] " _
& "(PatientID,GiftCardType,GiftCardNumber,GiftCardMailedDate,InterviewDate,CreatedBy,GpraCollectorID) VALUES " _
& "('" & rsInterview("PatientID") & "', '" & rsGiftcard("CardType") & "', '" & rsGiftcard("CompleteCardNumber") & "', Now(), '" & rsInterview("InterviewDate") & "', '" & rsInterview("CreatedBy") & "', '" & rsInterview("GpraCollectorID") & "');"
rsGiftcard.MoveNext
rsInterview.MoveNext
Loop Until rsInterview.EOF
End If
End If
sExit:
On Error Resume Next
rsInterview.Close
rsGiftcard.Close
Set rsInterview = Nothing
Set rsGiftcard = Nothing
Set db = Nothing
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "sAssignGiftCards", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit