Due to some technical error All Project source code & Project report are now available on www.ignousupport.blogspot.com Download all project for free
Bank Book
'******************************************************************
'******************************************************************
'** Author : Samee Ullah Siddiqui
'** Subject : Creating Bank Book
'** Date : Friday, December, 12, 2003
'** Modified : Friday, December, 12, 2003
'******************************************************************
'******************************************************************
Option Explicit
Dim Bal As Double
Dim TerminateLoop As Boolean
Dim BankCode, BankName As String
Private Sub CancelCmd_Click()
Unload Me
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then SendKeys "{TAB}"
End Sub
Private Sub Form_Load()
Dim SQL As String
Dt1.Value = Date
Dt2.Value = Date
If DE.BankBKConn.State = adStateOpen Then DE.BankBKConn.Close
DE.BankBKConn.Open ShapeConnectString
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
SQL = "SELECT * FROM ACMAST WHERE CASH = 'B' AND RECTYPE ='A'"
rst.Open SQL, DE.BankBKConn, adOpenForwardOnly, adLockReadOnly, adCmdText
Do Until rst.EOF
BankCB.AddItem rst!AcDESC
BankCB.ItemData(BankCB.NewIndex) = rst!AcCode
rst.MoveNext
Loop
If BankCB.ListCount > 0 Then
BankCB.ListIndex = 0
Else
OKCmd.Enabled = False
End If
End Sub
Private Sub OKCmd_Click()
Dim SQL As String
If OKCmd.Caption = "&OK" Then
If (Dt1.Value = "" Or (Not IsDate(Dt1.Value))) Then
MsgBox "Please enter a valid From date to view/print CASH BOOK", vbCritical, "Invalid Date"
Dt1.SetFocus
Exit Sub
ElseIf (Dt2.Value = "" Or (Not IsDate(Dt2.Value))) Then
MsgBox "Please enter a valid To date to view/print CASH BOOK", vbCritical, "Invalid Date"
Dt2.SetFocus
Exit Sub
End If
If CDate(Dt1.Value) > CDate(Dt2.Value) Then
MsgBox "To Date must greater then or equal to From Date", vbCritical, "Value Error..."
Exit Sub
End If
If BankCB.ListIndex < 0 Then
MsgBox "The Bank Book you want view/print could not be successfull because you have not select bank name of which Bank Book will be create." & vbCrLf & "Please Select Bank Name from drop down then press OK.", vbExclamation, "Missing Value..."
Exit Sub
Else
BankCode = GetProperCode(BankCB.ItemData(BankCB.ListIndex), 6)
BankName = BankCB.Text
End If
Dim CycleDate As Date
Dim i, V As Long
V = CDate(Dt2.Value) - CDate(Dt1.Value)
If V > 0 Then PB.Max = V
PB.Visible = True
DE.BankBKConn.BeginTrans
DE.BankBKConn.Execute "DELETE FROM BANKBOOK_TEMP"
Dim OpRst As New ADODB.Recordset
OpRst.CursorLocation = adUseClient
'Get Opening Amount of Selected Bank from ACTRANS table
Bal = 0
SQL = "SELECT * FROM ACTRANS WHERE ACCODE = '" & BankCode & "'"
OpRst.Open SQL, DE.BankBKConn, adOpenForwardOnly, adLockReadOnly, adCmdText
Bal = IIf(IsNull(OpRst!YOBDR), 0, OpRst!YOBDR)
If Bal = 0 Then Bal = IIf(IsNull(OpRst!YOBCR), 0, -OpRst!YOBCR)
OpRst.Close
'Get Opening Amount of Selected Bank from VOUCHER table
SQL = "SELECT SUM(DRAMT) AS DEBITAMT, SUM(CRAMT) AS CREDITAMT, SUM(DRAMT)-SUM(CRAMT) AS OPAMT FROM VOUCHER WHERE ACCODE = '" & BankCode & "' AND VDATE < '" & Dt1.Value & "'"
OpRst.Open SQL, DE.BankBKConn, adOpenForwardOnly, adLockReadOnly, adCmdText
Bal = Bal + IIf(IsNull(OpRst!OPAMT), 0, OpRst!OPAMT)
OKCmd.Caption = "&Abort"
CancelCmd.Enabled = False
TerminateLoop = False
Screen.MousePointer = vbHourglass
For CycleDate = Dt1.Value To Dt2.Value
If PrepairBankBook(CycleDate) Then
DoEvents
PB.Value = i
Label2(2).Caption = "Preparing of " & Format(CycleDate, "dd/mm/yy")
i = i + 1
If TerminateLoop Then
OKCmd.Caption = "&OK"
CancelCmd.Enabled = True
Screen.MousePointer = vbDefault
PB.Visible = False
Label2(2).Caption = ""
DE.BankBKConn.RollbackTrans
Exit Sub
End If
End If
Next CycleDate
Screen.MousePointer = vbDefault
OKCmd.Caption = "&OK"
CancelCmd.Enabled = True
PB.Visible = False
Label2(2).Caption = ""
DE.BankBKConn.CommitTrans
SQL = "SHAPE {SELECT * FROM BANKBOOK_TEMP;} AS BankBKCmd COMPUTE BankBKCmd, SUM(BankBKCmd.'CrAmt') AS CrTotal, SUM(BankBKCmd.'DrAmt') AS DrTotal BY 'VDATE'"
If DE.rsBankBKCmd_Grouping.State = adStateOpen Then DE.rsBankBKCmd_Grouping.Close
DE.rsBankBKCmd_Grouping.Open SQL, DE.BankBKConn, adOpenStatic, adLockReadOnly, adCmdText
Set BankBKRpt.DataSource = DE
With BankBKRpt
.Sections("DayBKCmd_Detail").Controls("txtDrNarr").Top = IIf(NarrChk.Value = vbChecked, 240, 0)
.Sections("DayBKCmd_Detail").Controls("txtDrNarr").Visible = NarrChk.Value = vbChecked
.Sections("DayBKCmd_Detail").Controls("txtCrNarr").Top = IIf(NarrChk.Value = vbChecked, 240, 0)
.Sections("DayBKCmd_Detail").Controls("txtCrNarr").Visible = NarrChk.Value = vbChecked
.Sections("DayBKCmd_Detail").Controls("Shape7").Height = IIf(NarrChk.Value = vbChecked, 480, 240)
.Sections("DayBKCmd_Detail").Controls("Shape8").Height = IIf(NarrChk.Value = vbChecked, 480, 240)
.Sections("DayBKCmd_Detail").Controls("Shape9").Height = IIf(NarrChk.Value = vbChecked, 480, 240)
.Sections("DayBKCmd_Detail").Height = IIf(NarrChk.Value = vbChecked, 480, 240)
End With
If Option1(0).Value Then
BankBKRpt.Show
Else
BankBKRpt.PrintReport
End If
Else
TerminateLoop = True
End If
End Sub
Private Function PrepairBankBook(ByVal DayDt As Date) As Boolean
Dim SQL As String
Dim i As Double
Dim CrRSt As New ADODB.Recordset
CrRSt.CursorLocation = adUseClient
Dim DrRSt As New ADODB.Recordset
DrRSt.CursorLocation = adUseClient
'Open Crdit Recordset
' SQL = "SELECT VOUCHER.SNO, VOUCHER.VTYPE, VOUCHER.VNO, VOUCHER.VDATE, VOUCHER.ACCODE, VOUCHER.ACCONTRA, VOUCHER.DRAMT, VOUCHER.CRAMT, VOUCHER.DRCR, ACMAST.ACDESC, COALESCE('(' + Voucher.NARR + ')','') AS NARRATION " & _
' "FROM VOUCHER INNER JOIN ACMAST ON VOUCHER.ACCODE = ACMAST.ACCODE WHERE VTYPE + VNO IN (SELECT VTYPE + VNO FROM VOUCHER WHERE ACCODE = '" & BankCode & "') AND VOUCHER.VDATE = '" & DayDt & "' AND VOUCHER.DRCR = 'C'"
SQL = "SELECT VOUCHER.SNO, VOUCHER.VTYPE, VOUCHER.VNO, VOUCHER.VDATE, VOUCHER.ACCODE, VOUCHER.ACCONTRA, VOUCHER.DRAMT, VOUCHER.CRAMT, VOUCHER.DRCR, ACMAST.ACDESC,COALESCE('(' + Voucher.NARR + ')',NULL) AS NARRATION " & _
"FROM VOUCHER INNER JOIN ACMAST ON VOUCHER.ACCODE = ACMAST.ACCODE WHERE VTYPE + VNO IN (SELECT VTYPE + VNO FROM VOUCHER WHERE ACCODE = '" & BankCode & "') AND VOUCHER.VDATE = '" & DayDt & "' AND VOUCHER.DRCR = 'C'"
CrRSt.Open SQL, DE.BankBKConn, adOpenForwardOnly, adLockReadOnly, adCmdText
'Open Debit Recordset
SQL = "SELECT VOUCHER.SNO, VOUCHER.VTYPE, VOUCHER.VNO, VOUCHER.VDATE, VOUCHER.ACCODE, VOUCHER.ACCONTRA, VOUCHER.DRAMT, VOUCHER.CRAMT, VOUCHER.DRCR, ACMAST.ACDESC,COALESCE('(' + Voucher.NARR + ')',NULL) AS NARRATION " & _
"FROM VOUCHER INNER JOIN ACMAST ON VOUCHER.ACCODE = ACMAST.ACCODE WHERE VTYPE + VNO IN (SELECT VTYPE + VNO FROM VOUCHER WHERE ACCODE = '" & BankCode & "') AND VOUCHER.VDATE = '" & DayDt & "' AND VOUCHER.DRCR = 'D'"
DrRSt.Open SQL, DE.BankBKConn, adOpenForwardOnly, adLockReadOnly, adCmdText
Dim TmpRst As New ADODB.Recordset
TmpRst.CursorLocation = adUseClient
TmpRst.Open "SELECT * FROM BANKBOOK_TEMP WHERE VDATE = '" & DayDt & "'", DE.BankBKConn, adOpenKeyset, adLockOptimistic, adCmdText
'Add a ROW for Selected Bank Opening (Opening)
TmpRst.AddNew
TmpRst!sno = TmpRst.RecordCount
TmpRst!vDate = DayDt
If Bal >= 0 Then
TmpRst!CRCode = "OP"
TmpRst!CrAmt = Bal
TmpRst!CRDESC = "By Opening " & BankName
ElseIf Bal < 0 Then
TmpRst!DRCode = "OP"
TmpRst!DrAmt = Bal
TmpRst!DRDESC = "To Opening " & BankName
End If
TmpRst.Update
Do Until DrRSt.EOF And CrRSt.EOF
SetCrValue:
If Not CrRSt.EOF Then
If CrRSt!AcCode <> BankCode Then 'Expect Selected Bank
TmpRst.AddNew
TmpRst!sno = TmpRst.RecordCount
TmpRst!vDate = CrRSt!vDate
TmpRst!CRCode = CrRSt!AcCode
TmpRst!CRDESC = "By " & CrRSt!AcDESC
TmpRst!CrAmt = CrRSt!CrAmt
TmpRst!CRNARR = CrRSt!NARRATION
Else
Bal = Bal - IIf(IsNull(CrRSt!CrAmt), 0, CrRSt!CrAmt)
If Not CrRSt.EOF Then CrRSt.MoveNext
GoTo SetCrValue
End If
End If
DoEvents
SetDrValue:
If Not DrRSt.EOF Then
If DrRSt.AbsolutePosition > CrRSt.RecordCount Then TmpRst.AddNew
If DrRSt!AcCode <> BankCode Then 'Expect Selected Bank
If Not IsNull(TmpRst!DRCode) Then TmpRst.AddNew
If IsNull(TmpRst!vDate) Then TmpRst!vDate = DrRSt!vDate
TmpRst!DRCode = DrRSt!AcCode
TmpRst!DRDESC = "To " & DrRSt!AcDESC
TmpRst!DrAmt = IIf(DrRSt!DrAmt = 0, Null, DrRSt!DrAmt)
TmpRst!DRNARR = DrRSt!NARRATION
Else
Bal = Bal + IIf(IsNull(DrRSt!DrAmt), 0, DrRSt!DrAmt)
If Not DrRSt.EOF Then DrRSt.MoveNext
GoTo SetDrValue
End If
End If
TmpRst.Update
If Not CrRSt.EOF Then CrRSt.MoveNext
If Not DrRSt.EOF Then DrRSt.MoveNext
Loop
'Add a ROW for Cash In Hand (Closing)
TmpRst.AddNew
TmpRst!sno = TmpRst.RecordCount
TmpRst!vDate = DayDt
If Bal >= 0 Then
TmpRst!DRCode = "CL"
TmpRst!DrAmt = Bal
TmpRst!DRDESC = "To Closing " & BankName
ElseIf Bal < 0 Then
TmpRst!CRCode = "CL"
TmpRst!CrAmt = Bal
TmpRst!CRDESC = "By Closing " & BankName
End If
TmpRst.Update
PrepairBankBook = True
End Function
Sponsored Links