0

I am using the code below to run through a table of payments and apply those payments to available balances. I keep having trouble where it will not move to the next payment.

Sometimes it will loop through payments, most times it will try to run the same payment again which causes an error since the payment is already used.

Public Sub applyPaymentsFunction(ByVal PaymentDate As String)
Dim dbs As Database
Dim rst As DAO.Recordset
Dim qry As String
Dim printedList As DAO.Recordset
Set dbs = CurrentDb

Set printedList = dbs.OpenRecordset("000AppliedPayments")
qry = "SELECT * FROM ReceivePayment WHERE (UnusedPayment > 0) AND TxnDate = #" + PaymentDate + "#"

Set rst = CurrentDb.OpenRecordset(qry)
If rst.RecordCount > 0 Then
rst.MoveFirst
    Do
        Debug.Print (rst("TxnID"))
        
        printedList.AddNew
        printedList!accountNumber = rst("CustomerRefFullName")
        printedList!Date = rst("TxnDate")
        printedList!Payment = rst("TotalAmount")
        printedList!AmountLeft = rst("UnusedPayment")
        printedList.Update
    
    Call applyPaymentsFunction2(rst("CustomerRefListID"), rst("TxnId"), rst("UnusedPayment"))

    rst.MoveNext
    Loop Until rst.EOF = True
rst.Close
End If
End Sub
Public Sub applyPaymentsFunction2(ByVal CustomerRefListID As String, ByVal PaymentTxnID As String, ByVal thisPayment As Integer)

Dim dbs As Database
Dim custrst As DAO.Recordset
Dim getCharges As String
Dim availPayment As Integer
Set dbs = CurrentDb

        availPayment = thisPayment
        getCharges = "SELECT TxnDate, TxnID, BalanceRemaining, Desc AS thisThing FROM Charge WHERE (CustomerRefListID = '" + CustomerRefListID + "'"
        getInvoices = "SELECT TxnDate, TxnID, BalanceRemaining, InvoiceLineDesc as thisThing FROM InvoiceLine WHERE (CustomerRefListID = '" + CustomerRefListID + "'"
        
        getCust = "SELECT * FROM Customer Where ParentRefListID = '" + CustomerRefListID + "'"
        Set custrst = CurrentDb.OpenRecordset(getCust)
        If custrst.RecordCount > 0 Then
            custrst.MoveFirst
                Do
                getCharges = getCharges + " OR CustomerRefListID = '" + custrst("ListId") + "'"
                getInvoices = getInvoices + " OR CustomerRefListID = '" + custrst("ListId") + "'"
                custrst.MoveNext
                Loop Until custrst.EOF = True
            custrst.Close
        End If
            
        getCharges = getCharges + ") AND (BalanceRemaining > 0)"
        getInvoices = getInvoices + ") AND (BalanceRemaining > 0)"
        joinedChargeInvoice = getCharges + "UNION ALL " + getInvoices + "ORDER BY TxnDate ASC"
        Set chargesrst = CurrentDb.OpenRecordset(joinedChargeInvoice)

        If chargesrst.RecordCount > 0 Then
        chargesrst.MoveFirst
            Do
                If availPayment = 0 Then
                    Exit Sub
                    
                ElseIf availPayment = chargesrst("BalanceRemaining") Then
                    Debug.Print ("INSERT INTO ReceivePaymentLine (TxnID, AppliedToTxnTxnID, AppliedToTxnPaymentAmount) VALUES ('" + PaymentTxnID + "', '" + chargesrst("TxnID") + "', " + Format(availPayment, "0.00") + " )")
                    DoCmd.RunSQL ("INSERT INTO ReceivePaymentLine (TxnID, AppliedToTxnTxnID, AppliedToTxnPaymentAmount) VALUES ('" + PaymentTxnID + "', '" + chargesrst("TxnID") + "', " + Format(availPayment, "0.00") + " )")
                    availPayment = 0
                    Exit Sub
                    
                ElseIf availPayment < chargesrst("BalanceRemaining") Then
                    Debug.Print ("INSERT INTO ReceivePaymentLine (TxnID, AppliedToTxnTxnID, AppliedToTxnPaymentAmount) VALUES ('" + PaymentTxnID + "', '" + chargesrst("TxnID") + "', " + Format(availPayment, "0.00") + " )")
                    DoCmd.RunSQL ("INSERT INTO ReceivePaymentLine (TxnID, AppliedToTxnTxnID, AppliedToTxnPaymentAmount) VALUES ('" + PaymentTxnID + "', '" + chargesrst("TxnID") + "', " + Format(availPayment, "0.00") + " )")
                    availPayment = 0
                    Exit Sub
                
                ElseIf availPayment > chargesrst("BalanceRemaining") Then
                    Debug.Print ("INSERT INTO ReceivePaymentLine (TxnID, AppliedToTxnTxnID, AppliedToTxnPaymentAmount) VALUES ('" + PaymentTxnID + "', '" + chargesrst("TxnID") + "', " + Format(chargesrst("BalanceRemaining"), "0.00") + " )")
                    DoCmd.RunSQL ("INSERT INTO ReceivePaymentLine (TxnID, AppliedToTxnTxnID, AppliedToTxnPaymentAmount) VALUES ('" + PaymentTxnID + "', '" + chargesrst("TxnID") + "', " + Format(chargesrst("BalanceRemaining"), "0.00") + " )")
                    availPayment = availPayment - chargesrst("BalanceRemaining")
                        
                End If
                    
            chargesrst.MoveNext
            Loop Until chargesrst.EOF = True Or availPayment = 0
        chargesrst.Close
        End If

End Sub

i have tried rst.MoveNext and rst.Move(1)

i have tried with and without the Exit Sub

i have tried 1 big query, and broken up into these two where it calls a separate sub

Kode
  • 1
  • 1

1 Answers1

0

I am pretty sure that the problem lies in the Exit Sub statements in your secondary subroutine. When you hit these, you are not closing the open recordset chargerst.

Admittedly it is a very long time since I programmed DAO in VBA, but I am sure there is a problem if you exit a subroutine leaving a recordset open and returning to a main routine. Please try always closing the chargerst recordset before calling Exit Sub

Jonathan Willcock
  • 5,012
  • 3
  • 20
  • 31
  • I added these in an attempt to make it stop and move to the next payment. However, they did not do so. I will try again without them though – Kode Feb 06 '23 at 20:33