Public Function fnInsertVoucher2()
Dim dblAdvance As Double
Dim dblMonthlyFee As Double
Dim dblAmountToPay As Double
Dim datIssueDate As Variant
Dim rs As dao.Recordset
Dim db As dao.Database
Dim strSQL As String
Dim lngRecordToProcess As Long
Dim lngCounter As Long
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT * FROM Voucher " & _
"WHERE NOT (Processed);", dbOpenDynaset)
With rs
If Not (.BOF And .EOF) Then _
.MoveLast: _
.MoveFirst: _
lngRecordToProcess = .RecordCount
lngRecordToProcess = IIf(lngRecordToProcess = 0, 1, lngRecordToProcess)
Call SysCmd(acSysCmdInitMeter, "Processing Voucher", lngRecordToProcess)
While Not .EOF
lngCounter = lngCounter + 1
Call SysCmd(acSysCmdUpdateMeter, lngCounter)
If ((!Advance.Value) = 0) Then
' no advances, just mark it as processed.
.Edit
!Processed.Value = True
.Update
Else
dblAdvance = 0
dblMonthlyFee = 0
dblAmountToPay = 0
' loop until we exhaust the advances
dblAdvance = !Advance.Value
' get monthly fee from student table
dblMonthlyFee = !MonthlyFee.Value
datIssueDate = Nz(!Issuedate.Value, 0)
dblAmountToPay = dblMonthlyFee
.Edit
!Processed.Value = True
If datIssueDate = 0 Then
datIssueDate = Date
!Issuedate.Value = datIssueDate
End If
.Update
While dblAdvance > 0
If dblAdvance < dblMonthlyFee Then
dblAmountToPay = dblAdvance
dblAdvance = 0
Else
dblAmountToPay = dblMonthlyFee
dblAdvance = dblAdvance - dblAmountToPay
End If
' (1). uncomment below line if you want IssueDate to always start at 1 day of the month
' datIssueDate = DateSerial(Year(datIssueDate), Month(datIssueDate) + 1, 0) + 1
'
' (2.) comment out this line if you want to use the above code (1).
datIssueDate = DateAdd("m", 1, datIssueDate)
strSQL = _
"INSERT INTO Voucher (" & _
"GR, StudentName, MonthlyFee, IssueDate, [Father Name], Class, [Mobile #], " & _
"[Date Of Birth], [Date Of Admission], [Paid], [Discount], PaidDate, Processed) "
strSQL = strSQL & "VALUES (" & _
!GR.Value & "," & Chr(34) & !StudentName.Value & Chr(34) & "," & !MonthlyFee.Value & "," & _
"#" & Format(datIssueDate, "mm/dd/yyyy") & "#," & _
IIf(IsNull(![Father Name].Value), "NULL", Chr(34) & ![Father Name].Value & Chr(34)) & "," & _
IIf(IsNull(!Class.Value), "NULL", Chr(34) & !Class.Value & Chr(34)) & "," & _
IIf(IsNull(![Mobile #].Value), "NULL", Chr(34) & ![Mobile #].Value & Chr(34)) & "," & _
IIf(IsNull(![Date Of Birth].Value), "NULL", "#" & Format(![Date Of Birth].Value, "mm/dd/yyyy") & "#") & "," & _
IIf(IsNull(![Date Of Admission].Value), "NULL", "#" & Format(![Date Of Admission].Value, "mm/dd/yyyy") & "#") & "," & _
dblAmountToPay & "," & _
IIf(IsNull(![Discount].Value), "NULL", ![Discount].Value) & "," & _
IIf(IsNull(!PaidDate.Value), "NULL", "#" & Format(!PaidDate.Value, "mm/dd/yyyy") & "#") & "," & "True);"
db.Execute strSQL
DBEngine.Idle dbFreeLocks
Wend
End If
Call SysCmd(acSysCmdUpdateMeter, lngCounter)
.MoveNext
Wend
.Close
Call SysCmd(acSysCmdRemoveMeter)
End With
Set rs = Nothing
Set db = Nothing
End Function