Solved

Error 3035 (System Resources exceeded) , Access 2003

Posted on 2014-01-31
12
2,975 Views
Last Modified: 2014-02-06
I had user encounter this error today.  I searched EE and found some references to this issues in Access 2010 and a hotfix that could be downloaded.  But I didn't find any references to this issue in Access 2003.

Anyone familiar with this one and how to resolve it in Access 2003.  

The users are running an Access 2003 MDE.
0
Comment
Question by:mlcktmguy
12 Comments
 
LVL 3

Expert Comment

by:bc10
ID: 39826209
What operating system are you using?  Is it 32 bit or 64?  What is the user doing when they encounter the error?  How big is the database?
0
 
LVL 84
ID: 39826259
What is the user doing when this happens? The error can mean many different things, so it's important to pinpoint what was happening when the error occurs.

For starters: Be sure the machine is fully up to date regarding Windows and Office updates.
0
 
LVL 57
ID: 39826310
There's not much you can do with this...most of the internal Access limits are non-adjustable.

To minimize encounting this, make sure your close all objects you open in code, and setting object variables to nothing.

 Also, in working with the app, make sure you close things as soon as you can.

 If this happened when executing a query, you may have run out of locks and there are a number of things you can do there.   Either you can set the query's UseTransaction property to no, or you can up the lock limit.

Give us some more details though and we'll see if we can't be a little more specific.

Jim.
0
 
LVL 1

Author Comment

by:mlcktmguy
ID: 39827850
Thanks you for your interest.  I try to be very careful to close and set to nothing each object I use.  In my case that is almost exclusively ADO recordsets.

There is a great deal of I/O involved just to post a record, which is the porcess that was executing when the error got thrown.  The user that got the error has run the posting process on their machine before without incident.  I'll post my code here in case anyone can spot an issue I might be overlooking.

Any help would be greatly appreciated.  This is one of those 'ghost' errors that can be very hard to track down but also very persistent.  

Any suggestions to make it more efficient would be appreciated as well.  In the 'getDelinquentBalance' routine I pull everything from the backend tables to local tables first to try and make the processing faster.  I'm going to raise the points on this one since it has gotten much more involved that I thought it would.

My error handler doesn't specify a specific line of code but here is the routine that threw the error.

Public Sub updateAllBalanceDueAmts(Optional passedBRT As Long = 0, _
                                   Optional passedMaxUpdates As Long = 100, _
                                   Optional passedShowStatusOnForm As Boolean = False)
'
Dim wkBRT As Long
Dim returnTotalDue As Double
Dim returnPrincipalDue As Double
Dim returnPenaltyDue As Double
Dim returnInterestDue As Double
Dim returnLienDue As Double
Dim returnAttyFeesDue As Double
Dim returnFeesDue As Double
'
Dim wkMaxToProcess As Long
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
'                      
                               If IsDeveloper Then
                               Else
                                 On Error GoTo updateAllBalanceDueAmts_Error
                               End If
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------

wkMaxToProcess = passedMaxUpdates
'
Dim wkElapsedTime As String
Dim wkStartTime As Date
Dim wkCurrTime As Date
Dim wkPayoffCalcDate As Date
'
wkStartTime = Now
wkCurrTime = wkStartTime
wkPayoffCalcDate = wkStartTime
'
Dim wkBalDueDate As Date
wkBalDueDate = Date
'
DoCmd.Hourglass True
'
recsRead = 0
dispCnt = 0
dispMax = 50
'
selectString = " Select [ID], [BRT] , [PayoffAmount], [DatePayoffCalculated], [PayStausID] from tblTaxHeader "
'
If passedBRT = 0 Then
Else
    selectString = selectString & " Where [BRT] = " & passedBRT
End If
'
'If passedCref = "ALL" Then
'Else
'    If passedTaxRecID = 0 Then  ' must where since this is the first where
'        selectString = selectString & " Where [UserAdded] = " & Chr(34) & passedCref & Chr(34)
'    Else  ' must use and since where is already used
'        selectString = selectString & " and [UserAdded] = " & Chr(34) & passedCref & Chr(34)
'    End If
'End If
'
Dim rsTax As ADODB.Recordset
Set rsTax = New ADODB.Recordset
rsTax.Open selectString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
If rsTax.EOF Then
    Exit Sub
Else
    If rsTax.RecordCount > 0 Then
        '
        rsTax.MoveLast
        rsTax.MoveFirst
        totRecs = rsTax.RecordCount
        '
        If totRecs > wkMaxToProcess Then
            totRecs = wkMaxToProcess
        End If
        '
        While Not rsTax.EOF And recsRead < wkMaxToProcess
            '
            recsRead = recsRead + 1
            '
            dispCnt = dispCnt + 1
            
            If dispCnt > dispMax Then
                wkCurrTime = Now
                wkElapsedTime = RunTime(wkStartTime, wkCurrTime)
                dispMsg = "Updating Balance Due Amounts, Processing Rec " & Trim(Str(recsRead)) & " Of " & Trim(Str(totRecs)) & " " & wkElapsedTime
                wkStatusRtn = SysCmd(acSysCmdSetStatus, dispMsg)
                If passedShowStatusOnForm Then
                        Forms!frmImport_SynchFile!lblStatus.Caption = dispMsg
                End If
                '
                DoEvents
                dispCnt = 0
            End If
            '
            wkBRT = Nz(rsTax!BRT, 0)
    
            If wkBRT <> 0 Then
                '
                returnTotalDue = 0
                returnPrincipalDue = 0
                returnPenaltyDue = 0
                returnInterestDue = 0
                returnLienDue = 0
                returnAttyFeesDue = 0
                returnFeesDue = 0
                '
                getDelinqBalanceDue wkBRT, _
                                    0, _
                                    9999, _
                                    Date, _
                                    cNoEndingDate, _
                                    cNoEndingDate, _
                                    returnTotalDue, _
                                    returnPrincipalDue, _
                                    returnPenaltyDue, _
                                    returnInterestDue, _
                                    returnLienDue, _
                                    returnAttyFeesDue, _
                                    returnFeesDue, _
                                    cNoNum, _
                                    ePostedStatus.ePosted, _
                                    cNoNum
                '
                With rsTax
                    '
                    !PayoffAmount = returnTotalDue
                    !DatePayoffCalculated = wkPayoffCalcDate
                    '
                    .Update
                End With
            End If
            '
            rsTax.MoveNext
        Wend
        '
    End If
End If
'
rsTax.Close
Set rsTax = Nothing
'
If passedBRT = 0 Then   ' don't show message for updating a single record
    dispMsg = "Complete, " & wkElapsedTime & " Processed " & Trim(Str(recsRead)) & " Records "
    wkStatusRtn = SysCmd(acSysCmdSetStatus, dispMsg)
End If
'
DoCmd.Hourglass False
'

'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
                               On Error GoTo 0
                               Exit Sub
updateAllBalanceDueAmts_Error:
                               sysErrorHandler Err.Number, Err.Description, "updateAllBalanceDueAmts", "modUpdateAllBalanceDueAmts", "Module"
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------


End Sub

Open in new window


This is the routine that calls that one

'
Public Function Post_Payments(passedBegDate As Date, _
                              passedEndDate As Date, _
                              passedPaySource As Long)
 
 
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
' 
                               If IsDeveloper Then
                               Else
                                 On Error GoTo Post_Payments_Error
                               End If
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
    
   Dim wkBRT As Long
   wkStartTime = Now
    
   '
    dispCnt = 5000
    dispMax = 5
    '
    recsRead = 0
    '
   NumRecs = 0
   PostAmt = 0#
   '
   selectString = "SELECT *  FROM tblPayments_Hdr "
   selectString = selectString & " WHERE  PostedStatusID = " & ePostedStatus.eUnposted
   selectString = selectString & " AND PaymentSourceID = " & passedPaySource
   selectString = selectString & " AND DepositDate >= #" & passedBegDate & "#"
   selectString = selectString & " AND DepositDate <= #" & passedEndDate & "#"
   
   Dim rstPay As ADODB.Recordset
   Set rstPay = New ADODB.Recordset
 
   rstPay.Open selectString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
   
   If Not rstPay.BOF Then
     rstPay.MoveFirst
     totRecs = rstPay.RecordCount
    '
    ' Go thru Payment Header Records
    '
     Do Until rstPay.EOF
        '
        recsRead = recsRead + 1
        '
        dispCnt = dispCnt + 1
        If dispCnt > dispMax Then
            wkCurrTime = Now()
            dispCnt = 0
            dispMsg = "Posting Payments, Step 1 of 1, Rec " & Format(recsRead, "Standard") & " Of " & Format(totRecs, "Standard") & RunTime(wkStartTime, wkCurrTime)
            wkStatusRtn = SysCmd(acSysCmdSetStatus, dispMsg)
            Forms!frmPostPayments.lblStatus.Caption = dispMsg
            DoEvents
        End If
       '
       wkBRT = Nz(rstPay!BRT, 0)
       '
       rstPay!PostedStatusID = ePostedStatus.ePosted        'mark the payment header as posted
       rstPay!PostingDate = Date
       '
       ' Process the Fee payment records associated with this header and update the status of the associated tax Fee records
       '
       process_Tax_Fee_Pmts rstPay!ID, rstPay!PostAs
       '
       ' Process the tax year payment records associated with this header and update the status of the associated tax year records
       '
       process_Tax_Year_Pmts rstPay!ID, rstPay!PostAs
       '
       '
       NumRecs = NumRecs + 1
       PostAmt = PostAmt + rstPay!PayAmt
       '
       rstPay.Update
       '
       ' uppdate the balance due/payoff on the tax header record
       '
       updateAllBalanceDueAmts wkBRT
       synchTaxHeader_wDetailRecs wkBRT
       
       '
       rstPay.MoveNext
     Loop
   End If
   
   MsgBox "Posted " & Trim(Str(NumRecs)) & " records." & vbCrLf & "Amount = $" & Format(PostAmt, "Standard")
   
   rstPay.Close

   Set rstPay = Nothing


'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
                               On Error GoTo 0
                               Exit Function
Post_Payments_Error:
                               sysErrorHandler Err.Number, Err.Description, "Post_Payments", "modPostPayments", "Module"
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------


End Function

Open in new window


Here is the mammoth routine'getDelinqBalanceDue' and all the routines it calls to get the balance due of the record being worked on.

Public Sub getDelinqBalanceDue(passedBRT As Long, _
                               passedFromYear As Long, _
                               passedThruYear As Long, _
                               passedBalanceThruDate As Date, _
                               passedInlcudePaymentsThruDate As Date, _
                               passedIncludeFeesEliExpThruDate As Date, _
                               returnTotalDue As Double, _
                               returnPrincipalDue As Double, _
                               returnPenaltyDue As Double, _
                               returnInterestDue As Double, _
                               returnLienDue As Double, _
                               returnAttyFeesDue As Double, _
                               returnFeesDue As Double, _
                               Optional passedWriteTmpPmntRecs As Long = cNoNum, _
                               Optional passedPosted_UnPosted_Both As Long = cPostedAndUnposted, _
                               Optional passedIncludeFullyPaid As Long = cNoNum, _
                               Optional passedUseTRBReduction As Boolean = False, _
                               Optional passedIPAgreementDate As Date = cNoDateFound, _
                               Optional passedPctPreAgreeInterestReduced As Double = 0, Optional passedPctPreAgreePenaltyReduced As Double = 0, _
                               Optional passedPctPreAgreeAttyFeesReduced As Double = 0, Optional passedPctPreAgreeLienCostReduced As Double = 0, _
                               Optional passedPctPostAgreeInterestReduced As Double = 0, Optional passedPctPostAgreePenaltyReduced As Double = 0, _
                               Optional passedPctPostAgreeAttyFeesReduced As Double = 0, Optional passedPctPostAgreeLienCostReduced As Double = 0)



                                
' These two variables are passed to contol the calculations when get a balance for the synch processing
'
'  passedInlcudePaymentsThruDate as Date
'  passedIncludeFeesEliExpThruDate as Date

                                
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
'                           
                               If IsDeveloper Then
                               Else
                                 On Error GoTo getDelinqBalanceDue_Error
                               End If
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------

returnTotalDue = 0
returnPrincipalDue = 0
returnPenaltyDue = 0
returnInterestDue = 0
returnLienDue = 0
returnAttyFeesDue = 0
returnFeesDue = 0
'
' Load tax and Interest Parms her just to get it over with so they are loaded for below
'
Dim wkPenaltyPct As Double
Dim wkPenaltyBeginMM As String
Dim wkPenaltyEndMM As String
Dim wkInterestPct As Double
Dim wkInterestBeginMM As String
Dim wkInterestEndMM As String
Dim wkAttyFeePct As Double
'
GetPenaltyInterestAttyParms wkPenaltyPct, _
                            wkPenaltyBeginMM, _
                            wkPenaltyEndMM, _
                            wkInterestPct, _
                            wkInterestBeginMM, _
                            wkInterestEndMM, _
                            wkAttyFeePct

'
'
' tblTaxHeader
' tblTaxRecs
' tblTaxRec_Fees
' tblPayments_Hdr
' tblPayments_YearSub
' tblPayments_Fees_Sub
'
ClearTable "tblzTmpWk_tblTaxHeader_Local"
ClearTable "tblzTmpWk_tblTaxRecs_Local"
ClearTable "tblzTmpWk_tblTaxRecs_Fees_Local"
ClearTable "tblzTmpWk_tblPayments_Hdr_Local"
ClearTable "tblzTmpWk_tblPayments_Year_Sub_Local"
ClearTable "tblzTmpWk_tblPayments_Fees_Sub_Local"
'
ClearTable "tblzTmpWk_TaxRecMain_BalDue_Local"
ClearTable "tblzTmpWk_TaxRecFees_BalDue_Local"
'
DoCmd.SetWarnings False
'
' Since this is year read only, no updating move year data
' to work tables prior to processing
'
'  Get Tax Recs /////////////////////////
'
'     TAX HEADER ....................................................................................
'
insertString = "INSERT INTO tblzTmpWk_tblTaxHeader_Local      SELECT * FROM tblTaxHeader Where [BRT] = " & passedBRT & _
                                                                    " And ( [Active_YN] = " & cYesNum & " )"
'
DoCmd.RunSQL insertString
'
'     TAX YEARS ....................................................................................
'
' Only select Active years within the span
'
insertString = "Insert Into tblzTmpWk_tblTaxRecs_Local  ( [TaxHeaderID], [PropertyID], [BRT], [TaxYear], [PrincipalAmt], [PenaltyAmt], [InterestAmt], [LienCost], [AttyFeesAmt], [EligExpAmt], [DateOfNumbers], [PayStausID], [Active_YN], [PrincipalBal], [PenaltyBal], [InterestBal], [LienBal],  [AttyFeesBal], [EligExpBal], [TRBAmount] ) " & _
                                                 " Select [TaxHeaderID], [PropertyID], [BRT], [TaxYear], [PrincipalAmt], [PenaltyAmt], [InterestAmt], [LienCost], [AttyFeesAmt], [EligExpAmt], [DateOfNumbers], [PayStausID], [Active_YN], [PrincipalAmt], [PenaltyAmt], [InterestAmt], [LienCost], [AttyFeesAmt], [EligExpAmt], [TRBAmount]   " & _
                                                 " From qryTaxRecs_wTRBAmounts " & _
                                                  " Where [TaxHeaderID] IN ( Select [ID] as [TaxHeaderID] From tblzTmpWk_tblTaxHeader_Local) " & _
                                                  " And ( [TaxYear] Between " & passedFromYear & " and " & passedThruYear & " )" & _
                                                  " And ( [Active_YN] = " & cYesNum & " )"
DoCmd.RunSQL insertString
'
'     TAX FEES ....................................................................................
'
insertString = "INSERT INTO tblzTmpWk_tblTaxRecs_Fees_Local   SELECT * FROM qryTaxRecs_Fees_wFeeDesc " & _
                                       " Where [FeeDate] <= " & Chr(35) & passedIncludeFeesEliExpThruDate & Chr(35) & _
                                       " And  ([TaxHdrID] IN ( Select [ID] as [TaxHdrID] From tblzTmpWk_tblTaxHeader_Local)) " & _
                                       " Order By [PaymentPriority], [GRBFeeType], [COPFeeType],  [FeeDate]                "
DoCmd.RunSQL insertString
'
Dim numTaxHdrRecs As Long
Dim numTaxYearRecs As Long
Dim numTaxFeeRecs As Long
'
On Error Resume Next
numTaxHdrRecs = DCount("[ID]", "tblzTmpWk_tblTaxHeader_Local")
numTaxYearRecs = DCount("[ID]", "tblzTmpWk_tblTaxRecs_Local")
numTaxFeeRecs = DCount("[ID]", "tblzTmpWk_tblTaxRecs_Fees_Local")
'
' Make sure tax recs were found, else return zeroes for balance due
'
If numTaxHdrRecs = 0 Then
    Exit Sub
End If
'
' There is a header rec, make sure there is year detail or Fee Detail, otherwise we're done.
'
If numTaxYearRecs = 0 And numTaxFeeRecs = 0 Then      ' Or numTaxYearRecs = 0 Then
    Exit Sub
End If
'
On Error GoTo 0
'
'  Get Pay Recs '///////////////////////////////////////
'
'     PAYMENTS HEADER ....................................................................................
'
insertString = "INSERT INTO tblzTmpWk_tblPayments_Hdr_Local       SELECT * FROM tblPayments_Hdr Where [BRT] = " & passedBRT
'
' do we posted and unposted
'
If passedPosted_UnPosted_Both = cPostedAndUnposted Then
    insertString = insertString & " And ([PostedStatusID] = " & ePostedStatus.ePosted & " Or " & _
                                        "[PostedStatusID] = " & ePostedStatus.eUnposted & ") "         '07/23/12 when inactive added
Else
    insertString = insertString & " And [PostedStatusID] = " & passedPosted_UnPosted_Both
End If
'
insertString = insertString & " And [PaymentDate] <= " & Chr(35) & passedInlcudePaymentsThruDate & Chr(35)
'
Debug.Print insertString
DoCmd.RunSQL insertString
'
'     PAYMENTS YEARS  ....................................................................................
'
insertString = "INSERT INTO tblzTmpWk_tblPayments_Year_Sub_Local  SELECT * FROM tblPayments_Year_Sub Where  " & _
                                     " [PaymentHdrID] IN ( Select [ID] as [PaymentHdrID] From tblzTmpWk_tblPayments_Hdr_Local) "
'
' don't check this on year records
'
'If passedPosted_UnPosted_Both = cPostedAndUnposted Then
'    insertString = insertString & " And ([PostedStatusID] = " & ePostedStatus.ePosted & " Or " & _
'                                        "[PostedStatusID] = " & ePostedStatus.eUnposted & ") "         '07/23/12 when inactive added
'Else
'    insertString = insertString & " And [PostedStatusID] = " & passedPosted_UnPosted_Both
'End If
'
DoCmd.RunSQL insertString
'
'     PAYMENTS FEES   ....................................................................................
'
'
insertString = "INSERT INTO tblzTmpWk_tblPayments_Fees_Sub_Local  SELECT * FROM qryPayments_Fees_Sub_wPayDateAndFeeDesc Where [PaymentHdrID] " & _
                                               "  IN ( Select [ID] as [PaymentHdrID] From tblzTmpWk_tblPayments_Hdr_Local) "
'
' don't check this on fee payment records
'
'If passedPosted_UnPosted_Both = cPostedAndUnposted Then
'    insertString = insertString & " And ([PostedStatusID] = " & ePostedStatus.ePosted & " Or " & _
'                                        "[PostedStatusID] = " & ePostedStatus.eUnposted & ") "         '07/23/12 when inactive added
'Else
'    insertString = insertString & " And [PostedStatusID] = " & passedPosted_UnPosted_Both
'End If
'
' put in order to match against fees
'
insertString = insertString & "  Order By [PaymentPriority], [GRBFeeType], [COPFeeType],  [PaymentDate]  "
'
DoCmd.RunSQL insertString
'
Dim wkYearTotalDue As Double
Dim wkYearPrincipalDue As Double
Dim wkYearPenaltyDue As Double
Dim wkYearInterestDue As Double
Dim wkYearLienDue As Double
Dim wkYearAttyFeesDue As Double
'Dim wkYearFeesDue As Double
'
Dim wkAllTotalDue As Double
Dim wkAllPrincipalDue As Double
Dim wkAllPenaltyDue As Double
Dim wkAllInterestDue As Double
Dim wkAllLienDue As Double
Dim wkAllAttyFeesDue As Double
Dim wkAllFeesDue As Double '
'
Dim wkTaxYear As Long
Dim wkYearDateOfNumbers As Date
'
wkYearTotalDue = 0
wkYearPrincipalDue = 0
wkYearPenaltyDue = 0
wkYearInterestDue = 0
wkYearLienDue = 0
wkYearAttyFeesDue = 0
'wkYearFeesDue = 0
'
wkAllTotalDue = 0
wkAllPrincipalDue = 0
wkAllPenaltyDue = 0
wkAllInterestDue = 0
wkAllLienDue = 0
wkAllAttyFeesDue = 0
wkAllFeesDue = 0

'
' If writing tax bal due records open them here then they are written in line
'
If passedWriteTmpPmntRecs = cYesNum Then
    '
    Set rsTmpTaxOut = New ADODB.Recordset
    rsTmpTaxOut.Open "tblzTmpWk_TaxRecMain_BalDue_Local", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    '
    Set rsTmpFeeOut = New ADODB.Recordset
    rsTmpFeeOut.Open "tblzTmpWk_TaxRecFees_BalDue_Local", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    '
End If
'
' for efficiency, open payment table here even though its used in another routine so it doesn't have to be opened and closed constantly below
'
'
'     TEMP YEAR PAYMENTS  ....................................................................................
'
selectString = "Select * From qrytblzTmpWk_tblPayments_Year_Sub_Local "

Set rsPayIn = New ADODB.Recordset
rsPayIn.Open selectString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
'
'     TEMP TAX YEAR RECORDS, This is Looped ....................................................................................
'
'
selectString = "Select * From qrytblzTmpWk_tblTaxRecs_Local "
'
Dim rsTaxIn As ADODB.Recordset
Set rsTaxIn = New ADODB.Recordset
rsTaxIn.Open selectString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'
If rsTaxIn.EOF Then
    'Exit Sub
Else
    If rsTaxIn.RecordCount > 0 Then
        '
        rsTaxIn.MoveFirst
        While Not rsTaxIn.EOF
            '
            wkTaxYear = Nz(rsTaxIn!TaxYear, 0)
            '
            If Nz(rsTaxIn!PayStausID, 0) = ePayStatus.ePaidInFull Then
                wkYearPrincipalDue = 0
                wkYearPenaltyDue = 0
                wkYearInterestDue = 0
                wkYearLienDue = 0
                wkYearAttyFeesDue = 0
                'wkYearFeesDue = 0
                
            Else
                '
                ' Check if want to use TRB, This is only passed and used when this routine is called to determine the balance on a TRB Payment plan
                '
                If passedUseTRBReduction And Nz(rsTaxIn!TRBAmount, 0) > 0 Then
                    '
                    ' this year has a TRB Reduction
                    '
                    wkYearPrincipalDue = Nz(rsTaxIn!TRBAmount, 0)
                    wkYearPenaltyDue = 0
                    wkYearInterestDue = 0
                    wkYearLienDue = 0
                    wkYearAttyFeesDue = 0
                    
                    'wkYearFeesDue = 0
                Else  ' calculate non TRB
                    wkYearPrincipalDue = Nz(rsTaxIn!PrincipalAmt, 0)
                    wkYearPenaltyDue = Nz(rsTaxIn!PenaltyAmt, 0)
                    wkYearInterestDue = Nz(rsTaxIn!InterestAmt, 0)
                    wkYearLienDue = Nz(rsTaxIn!LienCost, 0)
                    wkYearAttyFeesDue = Nz(rsTaxIn!AttyFeesAmt, 0)
                    'wkYearFeesDue = Nz(rsTaxIn!EligExpAmt, 0)
                End If ' if using TRB balance
                                '
                wkYearDateOfNumbers = Nz(rsTaxIn!DateOfNumbers, 0)
                '
                getThisYearsBalance wkTaxYear, _
                                    wkYearDateOfNumbers, _
                                    passedBalanceThruDate, _
                                    wkYearPrincipalDue, _
                                    wkYearPenaltyDue, _
                                    wkYearInterestDue, _
                                    wkYearLienDue, _
                                    wkYearAttyFeesDue, _
                                    wkPenaltyPct, _
                                    wkPenaltyBeginMM, _
                                    wkPenaltyEndMM, _
                                    wkInterestPct, _
                                    wkInterestBeginMM, _
                                    wkInterestEndMM, _
                                    wkAttyFeePct, _
                                    passedUseTRBReduction, passedIPAgreementDate, _
                                    passedPctPreAgreeInterestReduced, passedPctPreAgreePenaltyReduced, _
                                    passedPctPreAgreeAttyFeesReduced, passedPctPreAgreeLienCostReduced, _
                                    passedPctPostAgreeInterestReduced, passedPctPostAgreePenaltyReduced, _
                                    passedPctPostAgreeAttyFeesReduced, passedPctPostAgreeLienCostReduced
                                    
                
                                    
                                    
            End If  ' paid in full??
            '
            wkYearTotalDue = Round(wkYearPrincipalDue + wkYearPenaltyDue + wkYearInterestDue + wkYearLienDue + wkYearAttyFeesDue, 2) '+ wkYearFeesDue, 2)
            '
            wkAllPrincipalDue = Round(wkAllPrincipalDue + wkYearPrincipalDue, 2)
            wkAllPenaltyDue = Round(wkAllPenaltyDue + wkYearPenaltyDue, 2)
            wkAllInterestDue = Round(wkAllInterestDue + wkYearInterestDue, 2)
            wkAllLienDue = Round(wkAllLienDue + wkYearLienDue, 2)
            wkAllAttyFeesDue = Round(wkAllAttyFeesDue + wkYearAttyFeesDue, 2)
            '
            'wkAllFeesDue = Round(wkAllFeesDue + wkYearFeesDue, 2)
            '
            If passedWriteTmpPmntRecs = cYesNum Then
                rsTmpTaxOut.AddNew
                    rsTmpTaxOut!TaxRecID = Nz(rsTaxIn!ID, 0)
                    rsTmpTaxOut!TaxHeaderID = Nz(rsTaxIn!TaxHeaderID, 0)
                    rsTmpTaxOut!PropertyID = Nz(rsTaxIn!PropertyID, 0)
                    rsTmpTaxOut!BRT = passedBRT
                    rsTmpTaxOut!TaxYear = wkTaxYear
                    '
                    rsTmpTaxOut!PrincipalBalDue = wkYearPrincipalDue
                    rsTmpTaxOut!PenaltyBalDue = wkYearPenaltyDue
                    rsTmpTaxOut!InterestBalDue = wkYearInterestDue
                    rsTmpTaxOut!LienBalDue = wkYearLienDue
                    rsTmpTaxOut!AttyFeesBalDue = wkYearAttyFeesDue
                    rsTmpTaxOut!EligExpBalDue = 0
                    '
                    rsTmpTaxOut!PrincipalPaid = 0
                    rsTmpTaxOut!PenaltyPaid = 0
                    rsTmpTaxOut!InterestPaid = 0
                    rsTmpTaxOut!LienPaid = 0
                    rsTmpTaxOut!AttyFeesPaid = 0
                    rsTmpTaxOut!EligExpPaid = 0
                    '
                rsTmpTaxOut.Update
            End If
            '
            rsTaxIn.MoveNext
        Wend
    End If
End If
'
rsTaxIn.Close
Set rsTaxIn = Nothing
'
rsPayIn.Close
Set rsPayIn = Nothing
'
' Separate routine to do fee balances since they aren't year specifc but overall for the entire property
'
wkAllFeesDue = getFeeBalance(passedWriteTmpPmntRecs)
'

If passedWriteTmpPmntRecs = cYesNum Then
    '
    rsTmpTaxOut.Close
    Set rsTmpTaxOut = Nothing
    '
    rsTmpFeeOut.Close
    Set rsTmpFeeOut = Nothing
    '
End If
'
wkAllTotalDue = Round(wkAllPrincipalDue + wkAllPenaltyDue + wkAllInterestDue + wkAllLienDue + wkAllAttyFeesDue + wkAllFeesDue, 2)
'
If wkAllTotalDue > 0 Then
    returnTotalDue = wkAllTotalDue
    returnPrincipalDue = wkAllPrincipalDue
    returnPenaltyDue = wkAllPenaltyDue
    returnInterestDue = wkAllInterestDue
    returnLienDue = wkAllLienDue
    returnAttyFeesDue = wkAllAttyFeesDue
    returnFeesDue = wkAllFeesDue
Else
    returnTotalDue = 0
    returnPrincipalDue = 0
    returnPenaltyDue = 0
    returnInterestDue = 0
    returnLienDue = 0
    returnAttyFeesDue = 0
    returnFeesDue = 0
End If
'

'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
                               On Error GoTo 0
                               Exit Sub
getDelinqBalanceDue_Error:
                               sysErrorHandler Err.Number, Err.Description, "getDelinqBalanceDue", "modBalanceDueAndPayStuff", "Module"
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------


End Sub

Private Sub getThisYearsBalance(passedTaxYear As Long, _
                                passedDateOfNumbers As Date, _
                                passedBalanceThruDate As Date, _
                                passedPrincipalDue As Double, _
                                passedPenaltyDue As Double, _
                                passedInterestDue As Double, _
                                passedLienDue As Double, _
                                passedAttyFeesDue As Double, _
                                wkPenaltyPct As Double, _
                                wkPenaltyBeginMM As String, _
                                wkPenaltyEndMM As String, _
                                wkInterestPct As Double, _
                                wkInterestBeginMM As String, _
                                wkInterestEndMM As String, _
                                wkAttyFeePct As Double, _
                                passedUseTRBReduction As Boolean, passedIPAgreementDate As Date, _
                                passedPreAgreePctInterestReduced As Double, passedPreAgreePctPenaltyReduced As Double, _
                                passedPreAgreePctAttyFeesReduced As Double, passedPreAgreePctLienCostReduced As Double, _
                                passedPostAgreePctInterestReduced As Double, passedPostAgreePctPenaltyReduced As Double, _
                                passedPostAgreePctAttyFeesReduced As Double, passedPostAgreePctLienCostReduced As Double)
                               
'
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
'                           
                               If IsDeveloper Then
                               Else
                                 On Error GoTo getThisYearsBalance_Error
                               End If
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------

If passedBalanceThruDate <= passedDateOfNumbers Then    ' nothing to accumulate or calc, passed amounts are the final amounts
    Exit Sub
End If
'
' pull any payments after DateOfNumbers, step thru the months from the date of numbers date
' accumulate any new interest, penalty and/or atty fees.  But apply payments at the correct time to make
' sure the accumulations are correct.
'
'  ///////////////////// set up penalty and interest dates for this year
'
Dim wkPenaltyStartDate As Date
Dim wkPenaltyEndDate As Date
'
Dim wkInterestStartDate As Date
Dim wkInterestEndDate As Date
'
Dim wkPctWanted As Double
'
'
'
getPntyAndIntrStartEndDates passedTaxYear, _
                            wkPenaltyBeginMM, _
                            wkPenaltyEndMM, _
                            wkInterestBeginMM, _
                            wkInterestEndMM, _
                            wkInterestStartDate, _
                            wkInterestEndDate, _
                            wkPenaltyStartDate, _
                            wkPenaltyEndDate

'
Dim loopStartDate As Date
Dim loopEndDate As Date
Dim currLoopStartDate As Date
Dim currLoopEndDate As Date
Dim wkTempDate As Date
'
Dim newPrincipalDue As Double
Dim newPenaltyDue As Double
Dim newInterestDue As Double
Dim newLienDue As Double
Dim newAttyFeesDue As Double
'
Dim thisMMPenaltyDue As Double
Dim thisMMInterestDue As Double
Dim thisMMAttyFeesDue As Double
'
Dim inCyclePrincipalPaid As Double
Dim inCyclePenaltyPaid As Double
Dim inCycleInterestPaid As Double
Dim inCycleLeinPaid As Double
Dim inCycleAttyFeesPaid As Double
'
Dim wkPctInterestReduced As Double
Dim wkPctPenaltyReduced As Double
Dim wkPctAttyFeesReduced As Double
'
Dim thisIsFirstGetPaymentCall As Boolean
thisIsFirstGetPaymentCall = True
'
Dim wkFirstDayOfMonthOfAgreementDate As Date
wkFirstDayOfMonthOfAgreementDate = getFirstDayOfMonthDate(passedIPAgreementDate)
'
newPrincipalDue = passedPrincipalDue
newPenaltyDue = passedPenaltyDue
newInterestDue = passedInterestDue
newLienDue = passedLienDue
newAttyFeesDue = passedAttyFeesDue
'
loopStartDate = passedDateOfNumbers
loopEndDate = passedBalanceThruDate
'
currLoopStartDate = loopStartDate
currLoopEndDate = getLastDayOfMonthDate(currLoopStartDate) '

If currLoopEndDate > passedBalanceThruDate Then
    currLoopEndDate = passedBalanceThruDate
End If
'
' For tier plans
' May need logic prior to the loop to adjust the incoming numbers for this year.  If the date of the numbers is pror to the agreement or the
' same month as the agreement date, the pre-agreement date reduction must take place.  If after the agreement date ????
'
' Make any adjustments to Interest, Penalty or Atty Fees Based on Passed Parameters,
' These would be when requesting balances on Tier pay plans
'
' These adjustments only come in to play on tier plans.  To signify a Tier plan an agreement date is passed in
' filed passedIPAgreementDate, which is an optional paramter that defaults to the value of
' Public Const cNoDateFound As Date = #1/1/1980#
'
' if there is any date other than the default date, the associated reduction pcts are also passed.
' there are possibly agreement reductions and post agreement reductions.  They are all passed
'
' The passed agreement date is used to determine which set of reductions (pre agreement or post agreement)
' should be used.
'
' //////// Pre processing Reduction Logic, only applicable for Tier Payment Plans  ////////////////
'
If passedIPAgreementDate = cNoDateFound Then ' no reductions are needed
    wkPctInterestReduced = 0
    wkPctPenaltyReduced = 0
    wkPctAttyFeesReduced = 0
Else
    If wkFirstDayOfMonthOfAgreementDate < passedDateOfNumbers Then
        '
        ' need after agreement reductions
        '
        wkPctInterestReduced = passedPostAgreePctInterestReduced
        wkPctPenaltyReduced = passedPostAgreePctPenaltyReduced
        wkPctAttyFeesReduced = passedPostAgreePctAttyFeesReduced
    Else
        '
        ' Need preagreement reductions
        '
        wkPctInterestReduced = passedPreAgreePctInterestReduced
        wkPctPenaltyReduced = passedPreAgreePctPenaltyReduced
        wkPctAttyFeesReduced = passedPreAgreePctAttyFeesReduced
    End If
    '
    If wkPctInterestReduced > 0 Then
        If wkPctInterestReduced = 100 Then
            newInterestDue = 0
        Else
            wkPctWanted = Round(1 - (wkPctInterestReduced / 100), 2)
            newInterestDue = Round(newInterestDue * wkPctWanted, 2)
        End If
    End If
    '
    If wkPctPenaltyReduced > 0 Then
        If wkPctPenaltyReduced = 100 Then
            newPenaltyDue = 0
        Else
            wkPctWanted = Round(1 - (wkPctPenaltyReduced / 100), 2)
            newPenaltyDue = Round(newPenaltyDue * wkPctWanted, 2)
        End If
    End If
    '
    ' No atty Fees Prior to 1989
    '
    If passedTaxYear < 1989 Then
        newAttyFeesDue = 0
    Else
        If wkPctAttyFeesReduced > 0 Then
            If wkPctAttyFeesReduced = 100 Then
                newAttyFeesDue = 0
            Else
                wkPctWanted = Round(1 - (wkPctAttyFeesReduced / 100 / 100), 2)
                newAttyFeesDue = Round(newAttyFeesDue * wkPctWanted, 2)
            End If
        End If
    End If
End If
'
'
' //////// Regular Processing Loop /////////////////////////////////////////////////
'
'///////////////////////////////////////////////////////////////////////////////////
'
Do
    ' if first time thru don't need to accumm int, pen or atty fees they have already been included
    If Month(passedDateOfNumbers) = Month(currLoopStartDate) And _
       Year(passedDateOfNumbers) = Year(currLoopStartDate) Then
       '
        thisMMPenaltyDue = 0
        thisMMInterestDue = 0
        thisMMAttyFeesDue = 0
    Else
        '
        ' default these to zero
        '
        thisMMPenaltyDue = 0
        thisMMInterestDue = 0
        thisMMAttyFeesDue = 0
        '
        ' If this is a TRB year nothing will be due other than the TRB amount, no int, pen, lien, atty
        '
        If passedUseTRBReduction Then
            '
            thisMMPenaltyDue = 0
            thisMMInterestDue = 0
            thisMMAttyFeesDue = 0
            '
        Else
            '
            ' If principle balance greater than 0, calc new interest, penalty and atty fees
            '
            If Round(newPrincipalDue, 2) > 0 Then
                If currLoopStartDate >= wkInterestStartDate And currLoopStartDate <= wkInterestEndDate Then
        
                        thisMMInterestDue = Round(newPrincipalDue * wkInterestPct, 2)
                        If thisMMInterestDue < 0 Then
                            thisMMInterestDue = 0
                        End If
                End If
                '
                If currLoopStartDate >= wkPenaltyStartDate And currLoopStartDate <= wkPenaltyEndDate Then
                    
                    thisMMPenaltyDue = Round(newPrincipalDue * wkPenaltyPct, 2)
                    If thisMMPenaltyDue < 0 Then
                        thisMMPenaltyDue = 0
                    End If
                    
                End If
                '
                thisMMAttyFeesDue = Round((thisMMInterestDue * wkAttyFeePct) + (thisMMPenaltyDue * wkAttyFeePct), 2)
                '
                '
                ' If we are in the loop prior to or equal to the 1st day of the month of the agreement date then the pre agreement
                ' reductions are used.  If post agreement the post agreement reductions are used.
                '
                If passedIPAgreementDate = cNoDateFound Then ' no reductions are needed
                    wkPctInterestReduced = 0
                    wkPctPenaltyReduced = 0
                    wkPctAttyFeesReduced = 0
                Else
                    If wkFirstDayOfMonthOfAgreementDate > currLoopStartDate Then
                        '
                        ' need after agreement reductions
                        '
                        wkPctInterestReduced = passedPostAgreePctInterestReduced
                        wkPctPenaltyReduced = passedPostAgreePctPenaltyReduced
                        wkPctAttyFeesReduced = passedPostAgreePctAttyFeesReduced
                    Else
                        '
                        ' Need preagreement reductions
                        '
                        wkPctInterestReduced = passedPreAgreePctInterestReduced
                        wkPctPenaltyReduced = passedPreAgreePctPenaltyReduced
                        wkPctAttyFeesReduced = passedPreAgreePctAttyFeesReduced
                    End If
                    '
                    ' now apply any reductions
                    '
                    If wkPctInterestReduced > 0 Then
                        If wkPctInterestReduced = 100 Then
                            thisMMInterestDue = 0
                        Else
                            wkPctWanted = Round(1 - (wkPctInterestReduced / 100), 2)
                            thisMMInterestDue = Round(thisMMInterestDue * wkPctWanted, 2)
                        End If
                    End If
                    '
                    If wkPctPenaltyReduced > 0 Then
                        If wkPctPenaltyReduced = 100 Then
                            thisMMPenaltyDue = 0
                        Else
                            wkPctWanted = Round(1 - (wkPctPenaltyReduced / 100), 2)
                            thisMMPenaltyDue = Round(thisMMPenaltyDue * wkPctWanted, 2)
                        End If
                    End If
                    '
                    ' No atty Fees Prior to 1989
                    '
                    If passedTaxYear < 1989 Then
                        thisMMAttyFeesDue = 0
                    Else
                        If wkPctAttyFeesReduced > 0 Then
                            If wkPctAttyFeesReduced = 100 Then
                                thisMMAttyFeesDue = 0
                            Else
                                wkPctWanted = Round(1 - (wkPctAttyFeesReduced / 100 / 100), 2)
                                thisMMAttyFeesDue = Round(thisMMAttyFeesDue * wkPctWanted, 2)
                            End If
                        End If
                    End If
                End If
            '
            End If   ' principal > 0
        End If  'trb reduction
'
    End If ' loop start month?
    '
    newPenaltyDue = Round(newPenaltyDue + thisMMPenaltyDue, 2)
    newInterestDue = Round(newInterestDue + thisMMInterestDue, 2)
    newAttyFeesDue = Round(newAttyFeesDue + thisMMAttyFeesDue, 2)
    '
    If thisIsFirstGetPaymentCall Then  ' mo beginning data on payments pulled want everything up to and including the loopendDate
        thisIsFirstGetPaymentCall = False
        '
        getPaymentTotForThisCycle passedTaxYear, _
                                  cNoBeginDate, _
                                  currLoopEndDate, _
                                  inCyclePrincipalPaid, _
                                  inCyclePenaltyPaid, _
                                  inCycleInterestPaid, _
                                  inCycleLeinPaid, _
                                  inCycleAttyFeesPaid
    '
    Else    ' htis is not the first time thru, want payments for the cycle only
    '
    getPaymentTotForThisCycle passedTaxYear, _
                              currLoopStartDate, _
                              currLoopEndDate, _
                              inCyclePrincipalPaid, _
                              inCyclePenaltyPaid, _
                              inCycleInterestPaid, _
                              inCycleLeinPaid, _
                              inCycleAttyFeesPaid
    '
    End If
    '
    newPrincipalDue = Round(newPrincipalDue - inCyclePrincipalPaid, 2)
    newPenaltyDue = Round(newPenaltyDue - inCyclePenaltyPaid, 2)
    newInterestDue = Round(newInterestDue - inCycleInterestPaid, 2)
    newLienDue = Round(newLienDue - inCycleLeinPaid, 2)
    newAttyFeesDue = Round(newAttyFeesDue - inCycleAttyFeesPaid, 2)
    '
    ' need logic her in case newAtyy, newlien, newInt or new Pen less than zero.  Subtract overage from penalty.
    '
    ' If principal ends up  less than 0 ????????
    '
    
    wkTempDate = addOneMonth(currLoopStartDate)
    
    currLoopStartDate = getFirstDayOfMonthDate(wkTempDate)
    currLoopEndDate = getLastDayOfMonthDate(wkTempDate)
    '
    If Month(currLoopEndDate) = Month(passedBalanceThruDate) And _
       Year(currLoopEndDate) = Year(passedBalanceThruDate) Then
        '
        If currLoopEndDate > passedBalanceThruDate Then
            currLoopEndDate = passedBalanceThruDate
        End If
        '
    End If
    '

Loop While currLoopEndDate <= passedBalanceThruDate '  passedPaymentDate
'
passedPrincipalDue = newPrincipalDue
passedPenaltyDue = newPenaltyDue
passedInterestDue = newInterestDue
passedLienDue = newLienDue
passedAttyFeesDue = newAttyFeesDue
'passedFeesDue As Double, _
'

'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
                               On Error GoTo 0
                               Exit Sub
getThisYearsBalance_Error:
                               sysErrorHandler Err.Number, Err.Description, "getThisYearsBalance", "modBalanceDueAndPayStuff", "Module"
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------


End Sub
Public Sub getPaymentTotForThisCycle(passedTaxYear As Long, _
                                     passedBeginDate As Date, _
                                     passedEndDate As Date, _
                                     returnPrincipalPaid As Double, _
                                     returnPenaltyPaid As Double, _
                                     returnInterestPaid As Double, _
                                     returnLeinPaid As Double, _
                                     returnAttyFeesPaid As Double)
'
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
'                            
                               If IsDeveloper Then
                               Else
                                 On Error GoTo getPaymentTotForThisCycle_Error
                               End If
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------

returnPrincipalPaid = 0
returnPenaltyPaid = 0
returnInterestPaid = 0
returnLeinPaid = 0
returnAttyFeesPaid = 0
'
'
' rsPayIn is opened in the calling rotuine so it doens't have to be closed and re-opened each time this routine is called.
' Done for efficienct.
'
If rsPayIn.EOF Then
    Exit Sub
Else
    If rsPayIn.RecordCount > 0 Then
        '
        rsPayIn.MoveFirst
        While Not rsPayIn.EOF
            '
            If rsPayIn!TaxRecYear = passedTaxYear And _
               (rsPayIn!PaymentDate >= passedBeginDate And rsPayIn!PaymentDate <= passedEndDate) Then
                '
                returnPrincipalPaid = returnPrincipalPaid + Nz(rsPayIn!TaxAmount, 0)
                returnPenaltyPaid = returnPenaltyPaid + Nz(rsPayIn!PenaltyAmount, 0)
                returnInterestPaid = returnInterestPaid + Nz(rsPayIn!InterestAmount, 0)
                returnLeinPaid = returnLeinPaid + Nz(rsPayIn!LienAmount, 0)
                returnAttyFeesPaid = returnAttyFeesPaid + Nz(rsPayIn!AttyFeesAmount, 0)
                '
            End If
            '
            rsPayIn.MoveNext
        Wend
        '
        ' reset for next cyear
        '
        rsPayIn.MoveFirst
        '
    End If
End If

'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
                               On Error GoTo 0
                               Exit Sub
getPaymentTotForThisCycle_Error:
                               sysErrorHandler Err.Number, Err.Description, "getPaymentTotForThisCycle", "modBalanceDueAndPayStuff", "Module"
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------



End Sub
Public Function getFeeBalance(passedWriteTmpPmntRecs As Long) As Double
                         
'
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
'                           
                               If IsDeveloper Then
                               Else
                                 On Error GoTo getFeeBalance_Error
                               End If
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------

getFeeBalance = 0
'
Dim wkFeeBalance As Double
'

' 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 sorteded into order by FeePayment Priority (Court Costs are always last) and Fee Date, oldest first
'
' The fee payments are applied in 4 passes.
'  First pass matches the specifc tax feeid on the payment to a specific tax fee record.  Not all fee payments have a specific tax rec fee ID
'  Second Pass matches fee payments against fee records based on GRB Fee Desc, which is the long, more specific description.
'  Third Pass matches fee payments against fee records based on COP Fee Desc, which is the short less specific.
'  Fourth 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
'
selectString = " select * from tblzTmpWk_tblTaxRecs_Fees_Local Order By [FeeDate], [FeePeriod] "
'
Dim rsFeesIn As ADODB.Recordset
Set rsFeesIn = New ADODB.Recordset
rsFeesIn.Open selectString, 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
'
'
'///////////////////////////////////////////////////////////////////// 01/16/14
'///////////////////////////////////////////////////////////////////// 01/16/14
'///////////////////////////////////////////////////////////////////// 01/16/14
'///////////////////////////////////////////////////////////////////// 01/16/14
'///////////////////////////////////////////////////////////////////// 01/16/14
'
'///////////////////////////////// Can exit right now because we will always use the fee balance as the balance since payments adjust the balance
'//////////////////////////////// when posted.  Can't double dip and re-apply them here also.
'
'
'//////////////////////////////// 01/20/14 comment this go to when revised the fee posting logic to not update the curr balance on the fee record.
'//////////////////////////////// 01/20/14 comment this go to when revised the fee posting logic to not update the curr balance on the fee record.
'//////////////////////////////// 01/20/14 comment this go to when revised the fee posting logic to not update the curr balance on the fee record.
'//////////////////////////////// 01/20/14 comment this go to when revised the fee posting logic to not update the curr balance on the fee record.
'//////////////////////////////// 01/20/14 comment this go to when revised the fee posting logic to not update the curr balance on the fee record.

'
'
GoTo writeFeeBalanceRecIfNeeded
'
'do not need to calculate fee balance since payments are applied to the fee when posted.
' just use the curr balance as loaded
'
'///////////////////////////////////////////////////////////////////// 01/16/14
'///////////////////////////////////////////////////////////////////// 01/16/14
'///////////////////////////////////////////////////////////////////// 01/16/14
'///////////////////////////////////////////////////////////////////// 01/16/14
'///////////////////////////////////////////////////////////////////// 01/16/14
'///////////////////////////////////////////////////////////////////// 01/16/14
'
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 4
        '
        ' 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 4 passes.
                '   First pass matches the specifc tax feeid on the payment to a specific tax fee record.  Not all fee payments have a specific tax rec fee ID
                '   Second Pass matches fee payments against fee records based on GRB Fee Desc, which is the long, more specific description.
                '   Third Pass matches fee payments against fee records based on COP Fee Desc, which is the short less specific.
                '   Fourth 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 wkPayBal > 0 Then
                    '
                    ' If there is a balance see if it matches this tax rec.
                    '
                    If loopCnt = 1 Then
                        '
                        If Nz(rsPayIn!TaxFeeRecID, 0) = Nz(rsFeesIn!ID, 0) Then
                            matched = True
                        End If
                    
                    ElseIf loopCnt = 2 Then
                        '
                        If Nz(rsPayIn!GRBFeeType, "Pay") = Nz(rsFeesIn!GRBFeeType, "Fee") Then
                            matched = True
                        End If
                        '
                    ElseIf loopCnt = 3 Then
                        '
                        If Nz(rsPayIn!COPFeeType, "Pay") = Nz(rsFeesIn!COPFeeType, "Fee") Then
                            matched = True
                        End If
                        '
                    Else
                        '
                        ' This match happens when no specific matches took place
                        ' Don't do this for Court Costs (FeeID = 8).  Unless they are specifically chosen to pay (loop 1) or match on the name (loop2 or loop3)
                        '
                        ' More generally don't do this automatching for any Fee with a payment priority of 9999
                        '
                        If Nz(rsFeesIn!FeeID, 0) = 8 Or Nz(rsFeesIn!PaymentPriority, 0) = 9999 Then
                        Else
                            matched = True
                        End If
                    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
                            '
                            '
                        Else
                            matched = False
                        End If ' the fee record already has a blance of zero
                        '
                    End If ' does not match
                        '
                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 pass
        '
        If rsPayIn.EOF Then
        Else
            If rsPayIn.RecordCount > 0 Then
                rsPayIn.MoveFirst
            End If
        End If
        '
'
Next loopCnt
'
'
'
'
writeFeeBalanceRecIfNeeded:
'
'
'
'
'
' Write Fee Balance Record if needed
'
If passedWriteTmpPmntRecs = cYesNum Then
    '
    If rsFeesIn.EOF Then
    Else
        If rsFeesIn.RecordCount > 0 Then
            rsFeesIn.MoveFirst
        End If
    End If
    '
    While Not rsFeesIn.EOF
        '
        rsTmpFeeOut.AddNew
            rsTmpFeeOut!TaxHdrID = rsFeesIn!TaxHdrID
            rsTmpFeeOut!BRT = rsFeesIn!BRT
            rsTmpFeeOut!FeeDate = rsFeesIn!FeeDate
            '
            rsTmpFeeOut!FeePeriod = rsFeesIn!FeePeriod
            rsTmpFeeOut!FeeID = rsFeesIn!FeeID
            rsTmpFeeOut!FeeRecID = rsFeesIn!ID
            rsTmpFeeOut!FeeBalDue = rsFeesIn!FeeWorkingBalance
            rsTmpFeeOut!FeeDesc = rsFeesIn!GRBFeeType
            rsTmpFeeOut!PaymentPriority = rsFeesIn!PaymentPriority
            rsTmpFeeOut!FeePayment = 0
            '
        rsTmpFeeOut.Update
        '
        rsFeesIn.MoveNext
    Wend
    '
End If
'
'
rsFeesIn.Close
Set rsFeesIn = Nothing
'
rsPayIn.Close
Set rsPayIn = Nothing
'
wkFeeBalance = 0
'
On Error Resume Next
wkFeeBalance = DSum("[FeeWorkingBalance]", "tblzTmpWk_tblTaxRecs_Fees_Local", " [FeeWorkingBalance] > 0 ")
On Error GoTo 0
'
getFeeBalance = wkFeeBalance
'

'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
                               On Error GoTo 0
                               Exit Function
getFeeBalance_Error:
                               sysErrorHandler Err.Number, Err.Description, "getFeeBalance", "modBalanceDueAndPayStuff", "Module"
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------


End Function

Public Sub getPntyAndIntrStartEndDates(passedTaxYear As Long, _
                                       wkPenaltyBeginMM As String, _
                                       wkPenaltyEndMM As String, _
                                       wkInterestBeginMM As String, _
                                       wkInterestEndMM As String, _
                                       returnInterestStartDate As Date, _
                                       returnInterestEndDate As Date, _
                                       returnPenaltyStartDate As Date, _
                                       returnPenaltyEndDate As Date)

'
Dim wkTaxYear As Long
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
'                             
                               If IsDeveloper Then
                               Else
                                 On Error GoTo getPntyAndIntrStartEndDates_Error
                               End If
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------

wkTaxYear = passedTaxYear + 1   ' Interest and Penalty Start in subsequent year

'subtractOneMonth = CDate(Str(moNum) & "/" & Str(daNum) & "/" & Str(yrNum))
'
' Penalty Begins and Ends in the same year
'
returnPenaltyStartDate = CDate(wkPenaltyBeginMM & "/01/" & Trim(Str(wkTaxYear)))
returnPenaltyEndDate = CDate(wkPenaltyEndMM & "/01/" & Trim(Str(wkTaxYear)))
'
' Interest Accumulates Forever
'
returnInterestStartDate = CDate(wkInterestBeginMM & "/01/" & Trim(Str(wkTaxYear)))
returnInterestEndDate = CDate("12/31/" & Trim(Str(wkTaxYear + 50)))   ' add 50 year because Interest doesn't end
'

'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
                               On Error GoTo 0
                               Exit Sub
getPntyAndIntrStartEndDates_Error:
                               sysErrorHandler Err.Number, Err.Description, "getPntyAndIntrStartEndDates", "modBalanceDueAndPayStuff", "Module"
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------


End Sub

'Public Sub writeFeeBalDueRec(passedTaxRecID As Long, _
'                             passedTaxRecYear As Long, _
'                             passedFeeRecID As Long, _
'                             passedFeeBalDue As Double, _
'                             passedFeeDesc As String, _
'                             passedPaymentPriority As Long)
''
'Dim rsOut As ADODB.Recordset
'Set rsOut = New ADODB.Recordset
'rsOut.Open "tblTmpTaxRecFees_BalDue_Local", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
''
'With rsOut
'    .AddNew
'        !TaxRecID = passedTaxRecID
'        !TaxRecYear = passedTaxRecYear
'        !FeeRecID = passedFeeRecID
'        !FeeBalDue = passedFeeBalDue
'        !FeeDesc = passedFeeDesc
'        !PaymentPriority = passedPaymentPriority
'        !FeePayment = 0
'    .Update
'End With
''
'rsOut.Close
'Set rsOut = Nothing
'
'End Sub
Public Sub GetPenaltyInterestAttyParms(returnPenaltyPct As Double, _
                                         returnPenaltyBeginMM As String, _
                                         returnPenaltyEndMM As String, _
                                         returnInterestPct As Double, _
                                         returnInterestBeginMM As String, _
                                         returnInterestEndMM As String, _
                                         returnAttyFeePct As Double)

'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
'                      
                               If IsDeveloper Then
                               Else
                                 On Error GoTo GetPenaltyInterestAttyParms_Error
                               End If
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------

selectString = "Select * From tblParmFile "
'
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open selectString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

If rs.EOF Then
Else
    rs.MoveLast
    rs.MoveFirst
    If rs.RecordCount > 0 Then
        '
        returnPenaltyPct = Round(Nz(rs!PenaltyPct, 0) / 100, 4)
        returnPenaltyBeginMM = rs!BeginPenaltyMM
        returnPenaltyEndMM = rs!EndPenaltyMM
        returnInterestPct = Round(Nz(rs!InterestPct, 0) / 100, 4)
        returnInterestBeginMM = rs!BeginInterestMM
        returnInterestEndMM = rs!EndInterestMM
        returnAttyFeePct = Round(Nz(rs!AttyFeePct, 0) / 100, 4)
        
        '
    End If
End If
'
rs.Close
Set rs = Nothing
'

'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------
                               On Error GoTo 0
                               Exit Sub
GetPenaltyInterestAttyParms_Error:
                               sysErrorHandler Err.Number, Err.Description, "GetPenaltyInterestAttyParms", "modBalanceDueAndPayStuff", "Module"
'- - - - - - - - - - - - - - - - - - - - - - - - - - G E N E R A T E D  E R R O R  C O D E ----------------


End Sub

Open in new window

0
 
LVL 57
ID: 39829695
That's a lot to go through and I didn't go through it in detail, but there are two things I spotted:

1. DoCmd.RunSQL

 - Use CurrentDB().Exeute  , dbFailOnError

 Instead.  This allows you to trap errors.   I don't believe this is specific to your problem per say, but with RunSQL, your masking any possible problems in working with your tables.

2. Your procedures need to be structured differently as in the event of an error, no cleanup of objects occurs.  For example, post payments should look like this:

  MsgBox "Posted " & Trim(Str(NumRecs)) & " records." & vbCrLf & "Amount = $" & Format(PostAmt, "Standard")
   


 Post_Payments_Exit:

   On Error Resume Next

   rstPay.Close
   Set rstPay = Nothing

   On Error Goto 0

   Exit Function

Post_Payments_Error:
  sysErrorHandler Err.Number, err.Description, "Post_Payments", "modPostPayments", "Module"

  Resume Post_Payments_Exit

End Function


 Beyond that, I didn't go through what you posted in detail.   At first glance, it seems overly complex, but without understand the whole process, that may not be the case.  It's also hard to offer a different way of doing it.

 But not to leave you hanging, on this:

<<My error handler doesn't specify a specific line of code but here is the routine that threw the error.>>

 Add the un-documented VBA.ERL to your error handling calls and then use MZ tools (freeware):

 http://mztools.com/v3/mztools3.aspx

 To add line numbers to all your procedures.

 This will allow you to pin-point the specific line that is generating an error.

Jim.
0
 
LVL 1

Author Comment

by:mlcktmguy
ID: 39829768
Thank you.  I am using mztools (great tool) already to insert all of the current error handling logic.  I never used the line number option it offers.

Now pointed out, I can see that encountering an error would leave any open recordsets, open but the next step is that they are kicked out of the application (Quit).

Unfortunately it looks like this issue may be becoming more widespread.  Another user encountered it this morning.  She was in a different section of code that was also executing "GetDelinqBalanceDue"

This routine is very complex but here is a lot going on.  I tried to be very careful with opening and closing recordsets.  Some of the functionality could be broken off into into their own functions or subroutines but everything that is there, needs to happen to get a balance on an account.  Would breaking off pieces into separate function or subs help, even though all the functionality would still be executed?

This is a serious issue for me and any more help or input would be greatly appreciated.  I really have no ideas.



I requested that the moderator increase this to 500 points but that hasn't taken place yet.
0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 
LVL 57

Accepted Solution

by:
Jim Dettman (Microsoft MVP/ EE MVE) earned 500 total points
ID: 39829817
As I said, lot going on there and without really understanding the process, it's hard to offer anything, but I just spotted something else:

selectString = "SELECT *  FROM tblPayments_Hdr "

Avoid * for selecting fields unless you really need all the fields.  

One of the internal limits that Access has is 2048 table references.  It's not a hard limit, but floats around that number.

That doesn't sound bad, until you take into account that every field reference carries a table reference as well.  So it's very easy to get to 2048.

My suggestion would be to review your SQL statements and take that out where you can, add the line numbering to pin-point the statement that causes the error, then run and reasses if you get the error again.

Pin-pointing the line would give us clues as to what the problem are is.

Jim.
0
 
LVL 1

Author Comment

by:mlcktmguy
ID: 39829930
Thanks and I will do as you suggest.  

Couldn't find any documentation (surprise) on the undocumented VBA.Erl you mention above.  How do I use or reference this in the error handler?
0
 
LVL 1

Author Comment

by:mlcktmguy
ID: 39829954
One more point of clarification on the select statements and table references.

If I have a table (tblWith50Fields) with 50 fields (Field 01 - Field50) and open it using

"Select * tblWith50Fields ", have  I have uses 50 table references even if I only reference one of the fields (Field01)  in the code?

If so, I'm pretty sure I can trim table references.  I know I use the * in places I don't need it, sometimes out of sheer laziness for typing out the field names.
0
 
LVL 57
ID: 39830044
<<"Select * tblWith50Fields ", have  I have uses 50 table references even if I only reference one of the fields (Field01)  in the code?>>

 Yes.

<<Couldn't find any documentation (surprise) on the undocumented VBA.Erl you mention above.  How do I use or reference this in the error handler? >>

  Just as you would use err.num or err.description.  It's simply:

Debug.Print  vba.erl

Jim.
0
 
LVL 1

Author Comment

by:mlcktmguy
ID: 39834682
Just to follow up.  My first step in resolving this issue was to clean up my select statements from "Select * " to "select " only the field names needed in the logic.

Out of sheer laziness and ignorance to the ramifications I had used "Select *' just baout everywhere.

I changed dozens of select statements.  Today was the first production day with the new selects and no 3035 errors were encountered.

Didn't get a chance to number the lines or change the error handler to identify the specific line yet.
0
 
LVL 57
ID: 39835388
Hopefully that's what you were bumping into.   Time will tell.

Jim.
0

Featured Post

Complete Microsoft Windows PC® & Mac Backup

Backup and recovery solutions to protect all your PCs & Mac– on-premises or in remote locations. Acronis backs up entire PC or Mac with patented reliable disk imaging technology and you will be able to restore workstations to a new, dissimilar hardware in minutes.

Join & Write a Comment

The first two articles in this short series — Using a Criteria Form to Filter Records (http://www.experts-exchange.com/A_6069.html) and Building a Custom Filter (http://www.experts-exchange.com/A_6070.html) — discuss in some detail how a form can be…
Regardless of which version on MS Access you are using, one of the harder data-entry forms to create is one where most data from previous entries needs to be appended to new records, especially when there are numerous fields and records involved.  W…
Familiarize people with the process of utilizing SQL Server views from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Access…
In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now