Clipped from a macro I wrote years ago:
Private Sub cmdRecalc_Click()
Dim iLine As Integer
Dim nBalance As Double
Dim nThisAmount As Double
Dim ArPayments As AccpacView
Dim ArInvoices As AccpacView
Dim ArTermDetails As AccpacView
With a4wLink
.OpenView "AR0037", ArPayments
.OpenView "AR0036", ArInvoices
End With
With a4wLinkRead
.OpenView "AR0017", ArTermDetails
End With
' Make sure terms code selected
If Me.fldTerms.Value = "" Then
MsgBox "Please select a terms code", , Me.Caption
Exit Sub
End If
With frmStart
' Delete the existing payments
ArPayments.Cancel
ArPayments.Browse "IDCUST = """ & .fldCustomer & """ AND IDINVC = """ & .fldInvoice & """ AND SWPAID = 0", True
Do While ArPayments.Fetch
ArPayments.Delete
Loop
ArPayments.Cancel
ArPayments.Browse "IDCUST = """ & .fldCustomer & """ AND IDINVC = """ & .fldInvoice & """", True
ArTermDetails.Cancel
ArTermDetails.Browse "CODETERM = " & Me.fldTerms, True
ArPayments.GoBottom
iLine = ArPayments.Fields("CNTPAYM")
nBalance = .fldBalance
Dim iMonthadd As Integer
' Add the recalced ones
Do While ArTermDetails.Fetch
ArPayments.Init
iLine = iLine + 1
nThisAmount = Round(.fldBalance * ArTermDetails.Fields("PCTDUE") / 100, 2)
nBalance = nBalance - nThisAmount
ArPayments.Fields("IDCUST") = .fldCustomer
ArPayments.Fields("IDINVC") = .fldInvoice
ArPayments.Fields("CNTPAYM") = iLine
Select Case adsTerms.Fields("DISCTYPE")
Case 1
ArPayments.Fields("DATEDUE") = Me.dtHoldDate + ArTermDetails.Fields("DUEDAYS")
Case 2
Case 3
ArPayments.Fields("DATEDUE") = CDate(Year(Me.dtHoldDate) & "/" & Month(Me.dtHoldDate) + iMonthadd & "/" & ArTermDetails.Fields("DUEDAY"))
iMonthadd = iMonthadd + 1
Case 4
Case 5
End Select
ArPayments.Fields("AMTDUETC") = nThisAmount
ArPayments.Fields("AMTDUEHC") = nThisAmount
ArPayments.Fields("AMTPYMRMTC") = nThisAmount
ArPayments.Fields("AMTPYMRMHC") = nThisAmount
ArPayments.Fields("SWPAID") = 0
ArPayments.Fields("IDGRP") = .adsCustomer.Fields("IDGRP")
ArPayments.Fields("DATEINVC") = .adsInvoice.Fields("DATEINVC")
ArPayments.Insert
Loop
If Round(nBalance, 2) <> 0 Then
ArPayments.Fields("AMTDUETC") = ArPayments.Fields("AMTDUETC") + Round(nBalance, 2)
ArPayments.Fields("AMTDUEHC") = ArPayments.Fields("AMTDUEHC") + Round(nBalance, 2)
ArPayments.Fields("AMTPYMRMTC") = ArPayments.Fields("AMTPYMRMTC") + Round(nBalance, 2)
ArPayments.Fields("AMTPYMRMHC") = ArPayments.Fields("AMTPYMRMHC") + Round(nBalance, 2)
ArPayments.Update
End If
ArInvoices.Browse "IDCUST = """ & .fldCustomer & """ AND IDINVC = """ & .fldInvoice & """", True
ArInvoices.Fetch
ArInvoices.Fields("CNTTOTPAYM") = iLine
ArInvoices.Update
.vlcPayments.RefreshData
End With
Unload Me
End Sub