Scenario: a school with various types of charges to be paid.
Four tables:
tblAccounts: TransactionID,PeopleID, DatePaid, Amount,
TransactionTypeID, Balance
tblInvoices: InvoiceID,PeopleID, DateBilled, Amount,
TransactionTypeID, Balance
tblTransactionTypes: TransactionTypeID, Description,
TuitionRelated(Y/N)
tblPaymentAllocations: TransactionID, InvoiceID, PaymentAmount
(this records the amount from a particular payment applied to a
particular invoice, as they are not always evenly matched)
The idea here is to examine, in date order, all Payments in
tblAccounts where there is a nonzero balance, and apply them in date
order to all Invoices with a non-zero balance. When a payment is
applied to an Invoice, the Balance of the Payment and Invoice are
reduced accordingly. Also, a record is created in
tblPaymentAllocations.
Sometimes mistakes occur, so we also need the option to delete all
allocations, return all balances to the original amount, and
re-allocate. Therefore the first step is to see if the procedure was
called with “from scratch”, meaning, start from the beginning.
This was all working beautifully until I need to add one additional
element. The transaction types can be tuition-related (registration,
tuition, meals, transportation, etc.) or non-tuition related (mainly
pledges & their corresponding donations etc.). When someone makes a
tuition payment, we do not want the payment to be applied to a pledge,
and vice versa.
Therefore, after the “from scratch” condition, I moved all the code
out to a separate procedure, which is called twice, once for
tuition-related being true, and then for it being false.
Stepping through the code, I pasted the SQL into a query, corrected
(I’m pretty sure) all my mistakes, and was able to run the query.
However, as soon as I try to set the recordset to the sql, I get
“object variable or block not set”.
I’M STUMPED! Hope someone can tell me what I’m doing wrong.
Thanks.
‘ Allocating Payments Automatically
Public Sub pAllocatePayments(Optional FromScratch As Boolean)
Dim blFromScratch As Boolean
Dim stsql As String
Dim stMsg As String
If Nz(FromScratch, 0) = 0 Then
blFromScratch = False
Else
blFromScratch = True
End If
DoCmd.SetWarnings False
If blFromScratch = True Then
‘ delete all allocations
stsql = “delete from tblpaymentallocations where ((Peopleid)= ” &
[Forms]![frmpeople].[Form].[txtPeopleID] & “)”
DoCmd.RunSQL stsql
‘ restore the invoice balances
stsql = “Update tblinvoices set tblinvoices.balance =
tblinvoices.amount ”
stsql = stsql & ” where ((Peopleid)= ” &
[Forms]![frmpeople].[Form].[txtPeopleID] & “)”
DoCmd.RunSQL stsql
‘ restore the payment balances
stsql = “Update tblAccounts set tblAccounts.balance =
tblaccounts.amount ”
stsql = stsql & ” where ((Peopleid)= ” &
[Forms]![frmpeople].[Form].[txtPeopleID] & “)”
DoCmd.RunSQL stsql
End If
‘ first pay all tuition with tuition payments
pMatchUpPayments True
‘ Then pay all non-tuition
pMatchUpPayments False
DoCmd.SetWarnings True
End Sub
Public Sub pMatchUpPayments(blTuition As Boolean)
Dim db As Database
Dim dblAmount As Double
Dim rstPayments As Recordset
Dim rstInvoices As Recordset
Dim stsql As String
Dim stMsg As String
If Nz(blTuition, 0) = 0 Then
blTuition = False
Else
blTuition = True
End If
stsql = “SELECT ”
stsql = stsql & ” sum(tblAccounts.Balance) as TotalBalance, ”
stsql = stsql & ” count(tblAccounts.TransactionID) as NumPayments ”
stsql = stsql & ” FROM tblAccounts”
stsql = stsql & ” Left join tblTransactionTypes”
stsql = stsql & ” on tblAccounts.TransactionTypeID =
tblTransactionTypes.TransactionTypeID ”
stsql = stsql & ” WHERE (((tblAccounts.PeopleID) = ” &
[Forms]![frmpeople].[Form].[txtPeopleID] & “)”
stsql = stsql & ” and ((tblAccounts.Balance) > 0)”
stsql = stsql & ” and ((tblTransactionTypes.TuitionRelated) = ” &
blTuition & “)”
stsql = stsql & “);”
‘********************************
‘HERE’s where we get stuck
‘********************************
Set rstPayments = db.OpenRecordset(stsql)
With rstPayments
If .BOF And .EOF Then
MsgBox (“There were no balances to allocate at all!”)
Exit Sub
End If
End With
‘ if you didn’t exit yet, you’ll do this
stsql = “SELECT ”
stsql = stsql & ” Sum(tblInvoices.Balance) as TotalBalance,
”
stsql = stsql & ” count(tblInvoices.InvoiceID) as
NumInvoices ”
stsql = stsql & ” FROM tblInvoices”
stsql = stsql & ” Left join tblTransactionTypes”
stsql = stsql & ” on tblInvoices.TransactionTypeID =
tblTransactionTypes.TransactionTypeID ”
stsql = stsql & ” WHERE ((tblInvoices.PeopleID) = ” &
[Forms]![frmpeople].[Form].[txtPeopleID] & “)”
stsql = stsql & ” and ((tblInvoices.Balance) > 0)”
stsql = stsql & ” and ((tblTransactionTypes.TuitionRelated)
= ” & blTuition & “)”
stsql = stsql & ” ;”
Set rstInvoices = db.OpenRecordset(stsql)
With rstInvoices
If .BOF And .EOF Then
MsgBox (“There were no invoices to pay at all!”)
Exit Sub
Else
stMsg = “We will now allocate ” &
Format(rstPayments!totalbalance, “$0.00″) & ” from ”
stMsg = stMsg & rstPayments!NumPayments
stMsg = stMsg & ” payment” & IIf(rstPayments!NumPayments =
1, “”, “s”)
stMsg = stMsg & ” to pay ” & rstInvoices!Numinvoices & ”
invoice”
stMsg = stMsg & IIf(rstInvoices!Numinvoices = 1, “”, “s”)
stMsg = stMsg & ” totalling ” &
Format(rstInvoices!totalbalance, “$0.00”) & “.”
MsgBox (stMsg)
End If
End With
Do While True
‘ See if there’s money to allocate & Select the earliest payment
stsql = “SELECT TOP 1 tblAccounts.DATETRANS as CheckDate,
tblAccounts.AMOUNT as Amount, ”
stsql = stsql & ” tblAccounts.Balance as balance, ”
stsql = stsql & ” tblAccounts.TransactionID as PaymentID ”
stsql = stsql & ” FROM tblAccounts”
stsql = stsql & ” Left join tblTransactionTypes”
stsql = stsql & ” on tblAccounts.TransactionTypeID =
tblTransactionTypes.TransactionTypeID ”
stsql = stsql & ” WHERE (((tblAccounts.PeopleID) = ” &
[Forms]![frmpeople].[Form].[txtPeopleID] & “)”
stsql = stsql & ” And ((tblAccounts.Balance) > 0)”
stsql = stsql & ” and ((tblTransactionTypes.TuitionRelated) = ” &
blTuition & “)”
stsql = stsql & “)”
stsql = stsql & ” ORDER BY tblAccounts.DATETRANS;”
Set rstPayments = db.OpenRecordset(stsql)
‘ if not, exit loop
With rstPayments
If .BOF And .EOF Then
MsgBox (“All finished allocating the balances!”)
Exit Do
End If
End With
‘ Select the first invoice with non-zero balance
stsql = “SELECT TOP 1 tblInvoices.DATEBilled as BillDate,
tblInvoices.AMOUNT as Amount, ”
stsql = stsql & ” tblInvoices.Balance as balance, ”
stsql = stsql & ” tblInvoices.InvoiceID as INvoiceID ”
stsql = stsql & ” FROM tblInvoices”
stsql = stsql & ” Left join tblTransactionTypes”
stsql = stsql & ” on tblInvoices.TransactionTypeID =
tblTransactionTypes.TransactionTypeID ”
stsql = stsql & ” WHERE (((tblInvoices.PeopleID) = ” &
[Forms]![frmpeople].[Form].[txtPeopleID] & “)”
stsql = stsql & ” And ((tblInvoices.Balance) > 0)”
stsql = stsql & ” and ((tblTransactionTypes.TuitionRelated) = ” &
blTuition & “)”
stsql = stsql & “)”
stsql = stsql & ” ORDER BY tblInvoices.DATEbilled;”
Set rstInvoices = db.OpenRecordset(stsql)
‘ if not, exit loop
With rstInvoices
If .BOF And .EOF Then
MsgBox (“All Invoices are paid”)
Exit Do
End If
End With
dblAmount = smaller(rstPayments!Balance, rstInvoices!Balance)
stsql = “INSERT INTO tblPaymentAllocations ( InvoiceID, PaymentID,
PaymentAmount, PeopleID )”
stsql = stsql & ” SELECT ” & rstInvoices!InvoiceID & “, ”
stsql = stsql & rstPayments!PaymentID & “, ”
stsql = stsql & dblAmount & “, ” &
[Forms]![frmpeople].[Form].[txtPeopleID] & “;”
DoCmd.RunSQL stsql
stsql = “UPDATE tblInvoices ”
stsql = stsql & ” SET tblInvoices.Balance =
[tblinvoices].[amount]”
stsql = stsql & ” – ”
stsql = stsql & DSum(“paymentamount”, “tblpaymentallocations”,
“invoiceid=” & rstInvoices!InvoiceID)
stsql = stsql & ” where ((tblinvoices.invoiceid)= ” &
rstInvoices!InvoiceID & “)”
DoCmd.RunSQL stsql
stsql = “UPDATE tblaccounts ”
stsql = stsql & ” SET tblaccounts.Balance =
[tblaccounts].[amount]”
stsql = stsql & ” – ”
stsql = stsql & DSum(“paymentamount”, “tblpaymentallocations”,
“paymentid=” & rstPayments!PaymentID)
stsql = stsql & ” where ((tblaccounts.Transactionid)= ” &
rstPayments!PaymentID & “)”
DoCmd.RunSQL stsql
Loop
End Sub
