Update Third Table While Looping Through Two Recordsets

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

I reverted the code back to its working form and removed the INSERT code when I couldn’t get it to work. — Kevin Kissell, Dec 29 '20 at 04:01
Please place the `INSERT` code back into your question, exactly where you had it. — Applecore, Dec 29 '20 at 08:05
Per your request, I added the INSERT INTO code back in. I know its something stupid I'm missing. Thanks in advance. — Kevin Kissell, Dec 29 '20 at 15:54

score 0 · Answer 1 · answered Dec 29 '20 at 16:15

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

Yes, concatenation was needed. Or use declared parameters. https://stackoverflow.com/questions/49509615/how-do-i-use-parameters-in-vba-in-the-different-contexts-in-microsoft-access — June7, Dec 29 '20 at 20:18

Update Third Table While Looping Through Two Recordsets

1 Answers1