Option Compare Database
Option Explicit
Private db As DAO.Database
Private rs As DAO.Recordset
Private qd As DAO.QueryDef
Private td As DAO.TableDef
Private rsMtg As DAO.Recordset
Private qdMtg As DAO.QueryDef
Public Sub CreateAmortization(PropertyId As Variant, StartDate As Variant)
On Error GoTo Err_Proc
If IsNull(PropertyId) Then
MsgBox "Plese select a propertyID", vbOKOnly
Exit Sub
End If
If Not IsDate(StartDate) Then
MsgBox "Please select a start date.", vbOKOnly
Exit Sub
End If
DoCmd.RunCommand acCmdSaveRecord
DoCmd.RunMacro "mWarningsOff"
DoCmd.OpenQuery "qDelAmortization"
DoCmd.RunMacro "mWarningsOn"
Set db = CurrentDb()
Set qdMtg = db.QueryDefs!qMtgForProperty
qdMtg.Parameters![EnterPropertyID] = PropertyId
Set rsMtg = qdMtg.OpenRecordset
Do Until rsMtg.EOF = True
Call WriteRecs(CDate(StartDate))
rsMtg.MoveNext
Loop
Exit_Proc:
Exit Sub
Err_Proc:
Select Case Err.Number
Case Else
MsgBox Err.Number & "--" & Err.Description
Resume Exit_Proc
End Select
End Sub
Public Sub WriteRecs(StartDate As Date)
Dim Mths As Integer
Dim PmtNum As Integer
Dim BeginningBal As Currency
Dim EndingBal As Currency
Dim PmtDate As Date
Dim CumInt As Currency
Dim SchedPmt As Currency
Dim IntRate As Double
Dim PmtsPerYear As Integer
Dim MtgAmt As Currency
Dim MtgTerm As Integer
Dim PmtYear As Integer
Dim PmtMonth As Integer
On Error GoTo Exit_Proc
Set td = db.TableDefs!tblAmortization
Set rs = td.OpenRecordset
Mths = rsMtg!MortgageTermYears * 12
BeginningBal = rsMtg!MortgageAmt
PmtDate = StartDate
CumInt = 0
IntRate = rsMtg!InterestRate
PmtsPerYear = Nz(rsMtg!PmtsPerYear, 12)
MtgAmt = rsMtg!MortgageAmt
MtgTerm = rsMtg!MortgageTermYears
SchedPmt = -Pmt(IntRate / PmtsPerYear, MtgTerm * PmtsPerYear, MtgAmt, 0, 0)
PmtYear = 1
PmtMonth = 1
PmtNum = 1
Do Until PmtNum > Mths
rs.AddNew
rs!MortgageID = rsMtg!MortgageID
rs!PmtNum = PmtNum
rs!PmtYear = PmtYear
rs!PmtMonth = PmtMonth
rs!PmtDate = PmtDate
rs!BeginningBal = BeginningBal
rs!SchedPmt = SchedPmt
rs!ExtraPmt = Nz(rsMtg!ExtraPmt, 0)
rs!TotPmt = SchedPmt + rs!ExtraPmt
rs!Interest = BeginningBal * (IntRate / PmtsPerYear)
rs!Principal = rs!TotPmt - rs!Interest
rs!EndingBal = BeginningBal - rs!Principal
CumInt = CumInt + rs!Interest
rs!CumInterest = CumInt
BeginningBal = rs!EndingBal
PmtNum = PmtNum + 1
PmtDate = DateAdd("m", 1, PmtDate)
rs.Update
PmtMonth = PmtMonth + 1
If PmtMonth > 12 Then
PmtYear = PmtYear + 1
PmtMonth = 1
End If
Loop
Exit_Proc:
Exit Sub
Err_Proc:
Select Case Err.Number
Case Else
MsgBox Err.Number & "--" & Err.Description
Resume Exit_Proc
End Select
End Sub
