Next Chapter 32 Day Book

PROJECT SOURCE CODE

SPONSORED LINKS

Day Book

'******************************************************************

'******************************************************************

'** Author : Samee Ullah Siddiqui

'** Subject : Creating Day Book

'** Date : Saturday, December, 06, 2003

'** Modified : Thursday, December, 11, 2003

'******************************************************************

'******************************************************************

Option Explicit

Dim Bal As Double

Dim TerminateLoop As Boolean

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()

Dt1.Value = Date

Dt2.Value = Date

End Sub

Private Sub OKCmd_Click()

Dim SQL As String

On Error GoTo ErHand

If OKCmd.Caption = "&OK" Then

If (Dt1.Value = "" Or (Not IsDate(Dt1.Value))) Then

MsgBox "Please enter a valid From date to view/print DAY 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 DAY 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 DE.DayBKConn.State = adStateOpen Then DE.DayBKConn.Close

DE.DayBKConn.Open ShapeConnectString

Dim CycleDate As Date

Dim i, V As Long

V = CDate(DayBKFrm.Dt2.Value) - CDate(DayBKFrm.Dt1.Value)

If V > 0 Then PB.Max = V

PB.Visible = True

DE.DayBKConn.BeginTrans

DE.DayBKConn.Execute "DELETE FROM DAYBOOK_TEMP"

Dim OpRst As New ADODB.Recordset

OpRst.CursorLocation = adUseClient

'Get Opening Amount of Cash In Hand from ACTRANS table

Bal = 0

SQL = "SELECT * FROM ACTRANS WHERE ACCODE = '000030'"

OpRst.Open SQL, DE.DayBKConn, 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 Cash In Hand from VOUCHER table

SQL = "SELECT SUM(DRAMT) AS DEBITAMT, SUM(CRAMT) AS CREDITAMT, SUM(DRAMT)-SUM(CRAMT) AS OPAMT FROM VOUCHER WHERE ACCODE = '000030' AND VDATE < '" & Dt1.Value & "'"

OpRst.Open SQL, DE.DayBKConn, 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 PrepairDayBook(CycleDate, DE.DayBKConn) Then

DoEvents

Label2(2).Caption = "Preparing of " & Format(CycleDate, "dd/mm/yy")

PB.Value = i

i = i + 1

If TerminateLoop Then

OKCmd.Caption = "&OK"

CancelCmd.Enabled = True

Screen.MousePointer = vbDefault

PB.Visible = False

Label2(2).Caption = ""

DE.DayBKConn.CommitTrans

Exit Sub

End If

End If

Next CycleDate

Screen.MousePointer = vbDefault

OKCmd.Caption = "&OK"

CancelCmd.Enabled = True

PB.Visible = False

Label2(2).Caption = ""

DE.DayBKConn.CommitTrans

SQL = "SHAPE {SELECT * FROM DAYBOOK_TEMP;} AS DayBKCmd COMPUTE DayBKCmd, SUM(DayBKCmd.'CrAmt') AS CrTotal, SUM(DayBKCmd.'DrAmt') AS DrTotal BY 'VDATE'"

If DE.rsDayBKCmd_Grouping.State = adStateOpen Then DE.rsDayBKCmd_Grouping.Close

DE.rsDayBKCmd_Grouping.Open SQL, DE.DayBKConn, adOpenForwardOnly, adLockReadOnly, adCmdText

Set DayBKRpt.DataSource = DE

With DayBKRpt

.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

Unload Me

If Option1(0).Value Then

DayBKRpt.Show

Else

DayBKRpt.PrintReport

End If

Else

TerminateLoop = True

End If

Exit Sub

ErHand:

ErrHandler "DayBook.OkCmd_Click()"

DE.DayBKConn.RollbackTrans

End Sub

Private Function PrepairDayBook(ByVal DayDt As Date, ByVal Conn As ADODB.Connection) 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.ACCODE, Voucher.VDATE, ACMAST.ACDESC, Voucher.DRAMT, Voucher.CRAMT, Voucher.DRCR, COALESCE('(' + Voucher.NARR + ')','') AS NARRATION " & _

"FROM Voucher INNER JOIN ACMAST ON Voucher.ACCODE = ACMAST.ACCODE WHERE VDATE = '" & DayDt & "' AND DRCR = 'C'"

CrRSt.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText

'Open Debit Recordset

SQL = "SELECT Voucher.ACCODE, Voucher.VDATE, ACMAST.ACDESC, Voucher.DRAMT, Voucher.CRAMT, Voucher.DRCR, COALESCE('(' + Voucher.NARR + ')','') AS NARRATION " & _

"FROM Voucher INNER JOIN ACMAST ON Voucher.ACCODE = ACMAST.ACCODE WHERE VDATE = '" & DayDt & "' AND DRCR = 'D'"

DrRSt.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText

Dim TmpRst As New ADODB.Recordset

TmpRst.CursorLocation = adUseClient

TmpRst.Open "SELECT * FROM DAYBOOK_TEMP WHERE VDATE = '" & DayDt & "'", Conn, adOpenKeyset, adLockOptimistic, adCmdText

'Add a ROW for Cash In Hand (Opening)

TmpRst.AddNew

TmpRst!sno = TmpRst.RecordCount

TmpRst!vDate = DayDt

If Bal >= 0 Then

TmpRst!CRCode = "OP"

TmpRst!CrAmt = Bal

TmpRst!CRDESC = "By Opening Cash"

ElseIf Bal < 0 Then

TmpRst!DRCode = "OP"

TmpRst!DrAmt = Bal

TmpRst!DRDESC = "To Opening Cash"

End If

TmpRst.Update

Do Until DrRSt.EOF And CrRSt.EOF

SetCrValue:

If Not CrRSt.EOF Then

If CrRSt!AcCode <> "000030" Then 'Expect Cash In Hand

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 <> "000030" Then 'Expect Cash In Hand

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 Cash"

ElseIf Bal < 0 Then

TmpRst!CRCode = "CL"

TmpRst!CrAmt = Bal

TmpRst!CRDESC = "By Closing Cash"

End If

TmpRst.Update

PrepairDayBook = True

End Function