Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action. Forget about retraining and skyrocket knowledge retention rates.
Public Function getFeeBalance(passedWriteTmpPmntRecs As Long) As Double ' getFeeBalance = 0 ' ' This routine matches fee payments against fees with a balance due. Prior to this routine ' ' Property specific Fee payments have been loaded into into 'tblzTmpWk_tblPayments_Fees_Sub_Local' ' ' Property specific Fee records have been loaded into 'tblzTmpWk_tblTaxRecs_Fees_Local' ' ' Prior to processing the record are sorted into order by FeePayment Priority (Court Costs are always last) and Fee Date, oldest first ' ' The fee payments are applied in 3 passes. ' First Pass matches fee payments against fee records based on GRB Fee Desc, which is the long more specific description. ' Second Pass matches fee payments against fee records based on COP Fee Desc, which is the short less specific. ' Third pass just applies any remaining payment balances to the fees in the order they ares sorted until all payments havbe been applied. ' ' Lastly, if we are doing this for payment distribution purposes records are written to the table 'tblzTmpWk_TaxRecFees_BalDue_Local' at the end ' ' ' First every payment record must set the 'PaymentWorkingBalance' to the FeePaymentAmount since it always defaults ' to zero when the table is loaded ' updateString = "Update tblzTmpWk_tblPayments_Fees_Sub_Local " & _ " SET [PaymentWorkingBalance] = [FeePayment] " DoCmd.SetWarnings False DoCmd.RunSQL updateString ' ' Also ' ' First every fee record must set the 'FeeWorkingBalance' to the CurrBalanceAmt since it always defaults ' to zero when the table is loaded ' updateString = "Update tblzTmpWk_tblTaxRecs_Fees_Local " & _ " SET [FeeWorkingBalance] = [CurrBalanceAmt] " DoCmd.SetWarnings False DoCmd.RunSQL updateString ' ' ' Dim rsFeesIn As ADODB.Recordset Set rsFeesIn = New ADODB.Recordset rsFeesIn.Open "tblzTmpWk_tblTaxRecs_Fees_Local", CurrentProject.Connection, adOpenKeyset, adLockOptimistic ' Dim rsPayIn As ADODB.Recordset Set rsPayIn = New ADODB.Recordset rsPayIn.Open "tblzTmpWk_tblPayments_Fees_Sub_Local", CurrentProject.Connection, adOpenKeyset, adLockOptimistic ' Dim matched As Boolean Dim loopCnt As Long ' Dim wkPayBal As Double Dim wkFeeBal As Double 'Dim wkPayOrigAmt As Double 'Dim wkFeeOrigAmt As Double ' Dim wkAmountPaid As Double ' For loopCnt = 1 To 3 ' ' Position fee recs to first rec ' If rsFeesIn.EOF Then Else If rsFeesIn.RecordCount > 0 Then rsFeesIn.MoveFirst End If End If ' ' Position fee payments to first rec ' If rsPayIn.EOF Then Else If rsPayIn.RecordCount > 0 Then rsPayIn.MoveFirst End If End If ' ' Payments will be the driver ' While Not rsPayIn.EOF ' each payment record is matched against all of the fees before the next payment is read ' ' First time thru for every payment must move the payment amount to ' ' set payment balance for loop ' wkPayBal = rsPayIn!PaymentWorkingBalance ' ' Have payment record, match it against fee records ' While Not rsFeesIn.EOF ' lopps thru the fee records looking to match any payments ' ' The fee payments are applied in 3 passes. ' First Pass matches fee payments against fee records based on GRB Fee Desc, which is the long more specific description. ' Second Pass matches fee payments against fee records based on COP Fee Desc, which is the short less specific. ' Third pass just applies any remaining payment balances to the fees in the order they ares sorted until all payments havbe been applied. ' matched = False ' ' make sure there is a balance on the payment ' If rsPayIn!PaymentWorkingBalance > 0 Then ' ' If there is a balance see if it matches this tax rec. ' If loopCnt = 1 Then ' If Nz(rsPayIn!GRBFeeType, "Pay") = Nz(rsFeesIn!GRBFeeType, "Fee") Then matched = True End If ' ElseIf loopCnt = 2 Then ' If Nz(rsPayIn!COPFeeType, "Pay") = Nz(rsFeesIn!COPFeeType, "Fee") Then matched = True End If ' Else matched = True End If ' If matched = True Then ' apply the payment to the fee record. ' wkAmountPaid = 0 ' wkFeeBal = rsFeesIn!FeeWorkingBalance 'wkFeeOrigAmt = rsFeesIn!CurrBalanceAmt ' If wkFeeBal > 0 Then ' If wkPayBal <= wkFeeBal Then wkAmountPaid = wkPayBal Else wkAmountPaid = wkFeeBal End If ' wkFeeBal = wkFeeBal - wkAmountPaid wkPayBal = wkPayBal - wkAmountPaid ' ' update the working balance on the fee record ' rsFeesIn!FeeWorkingBalance = wkFeeBal rsFeesIn.Update ' ' update the working balance on the fee record ' ' End If ' the fee record already has a blance of zero ' End If ' payment record work balance = 0 ' rsFeesIn.MoveNext ' Wend ' ' Any payment appllications have been done and the final balance is in this variable ' update the balance on the pay record for any subseqent loops. ' rsPayIn!PaymentWorkingBalance = wkPayBal rsPayIn.Update ' rsPayIn.MoveNext Wend ' ' reset for next cyear ' rsPayIn.MoveFirst ' End If ' Next loopCnt ' rsFeesIn.Close Set rsFeesIn = Nothing ' rsPayIn.Close Set rsPayIn = Nothing ' On Error Resume Next ' getFeeBalance = DSum("[FeeWorkingBalance]", "rsFeesIn") ' On Error GoTo 0 ' End Function
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
|PowerPivot (or MS Access ) -- Opening & Closing Balance||21||55|
|How to requery/refresh another form in VBA if you only know its name as a string.||5||50|
|Excel graph in access report||1||32|
|2 Global Vars, 1 List Box||4||30|
Join the community of 500,000 technology professionals and ask your questions.