frmcollectionae.frm

Inventory control system

        cCAmount = cCAmount + toNumber(txtPayment.Text)
        txtTA.Text = toMoney(cCAmount)
        'Highlight the current row's column
        .ColSel = 8
        'Display a remove button
        Grid_Click
        'Reset the entry fields
        ResetEntry
    End With
End Sub

Private Sub btnRemove_Click()
    'Remove selected load product
    With Grid
        'Update amount to current collection amount
        cCAmount = cCAmount - toNumber(Grid.TextMatrix(.RowSel, 5))
        txtTA.Text = toMoney(cCAmount)
        'Update the record count
        cCRowCount = cCRowCount - 1

        If .Rows = 2 Then Grid.Rows = Grid.Rows + 1
        .RemoveItem (.RowSel)
    End With

    btnRemove.Visible = False
    Grid_Click
End Sub

Private Sub cbPT_Click()
    If cbPT.ListIndex = 0 Then
        Check.Visible = False
    Else
        Check.Visible = True
    End If
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdExpenses_Click()
    With frmSalesExpenses
        .PK = PK
        
        .show 1
    End With
End Sub

Private Sub cmdSave_Click()
    'Verify the entries
       
    If dcBooking.BoundText = "" Then
        MsgBox "Please select a booking agent.", vbExclamation
        dcBooking.SetFocus
        Exit Sub
    End If
    
    If dcCollection.BoundText = "" Then
        MsgBox "Please select a collection agent.", vbExclamation
        dcCollection.SetFocus
        Exit Sub
    End If

    If cCRowCount < 1 Then
        MsgBox "Please enter a collection first before saving this record.", vbExclamation
        txtEntry(0).SetFocus
        Exit Sub
    End If

    If MsgBox("This save the record.Do you want to proceed?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
    
    rs.Close
    rs.Open "SELECT * FROM Receipts_Batch WHERE ReceiptBatchID=" & PK, CN, adOpenStatic, adLockOptimistic

    Dim RSDetails As New Recordset

    RSDetails.CursorLocation = adUseClient
    RSDetails.Open "SELECT * FROM Collection_Details WHERE ReceiptBatchID=" & PK, CN, adOpenStatic, adLockOptimistic

    Screen.MousePointer = vbHourglass

    Dim c As Integer

    On Error GoTo err

    CN.BeginTrans

    DeleteItems
    
    'Save the record
    With rs

        ![Status] = IIf(cboStatus.Text = "Collected", True, False)
        ![Remarks] = txtEntry(3).Text
        ![Gross] = toMoney(txtTA.Text)
        
        .Update
    End With

    With Grid
        'Save the details of the records
        For c = 1 To cCRowCount
            .Row = c
            If State = adStateAddMode Or State = adStatePopupMode Then
AddNew:
                RSDetails.AddNew

                RSDetails![ReceiptBatchID] = PK
                RSDetails![RefNo] = .TextMatrix(c, 1)
                RSDetails![ClientID] = .TextMatrix(c, 8)
                RSDetails![ChargeAccount] = .TextMatrix(c, 3)
                RSDetails![PaymentType] = .TextMatrix(c, 4)
                RSDetails![Amount] = toNumber(.TextMatrix(c, 5))
                RSDetails![Balance] = toNumber(.TextMatrix(c, 6))
                RSDetails![Remarks] = .TextMatrix(c, 7)
                RSDetails![ReceiptID] = .TextMatrix(c, 9)
         
                RSDetails.Update
            ElseIf State = adStateEditMode Then
                RSDetails.Filter = "CollectionDetailID = " & toNumber(.TextMatrix(c, 10))
            
                If RSDetails.RecordCount = 0 Then GoTo AddNew
                
                RSDetails![ReceiptBatchID] = PK
                RSDetails![RefNo] = .TextMatrix(c, 1)
                RSDetails![ClientID] = .TextMatrix(c, 8)
                RSDetails![ChargeAccount] = .TextMatrix(c, 3)
                RSDetails![PaymentType] = .TextMatrix(c, 4)
                RSDetails![Amount] = toNumber(.TextMatrix(c, 5))
                RSDetails![Balance] = toNumber(.TextMatrix(c, 6))
                RSDetails![Remarks] = .TextMatrix(c, 7)
                RSDetails![ReceiptID] = .TextMatrix(c, 9)
         
                RSDetails.Update
            End If
            
            If cboStatus.Text = "Collected" Then
                Dim LedgerID As Integer
                
                LedgerID = getIndex("Clients_Ledger")
                CN.Execute "INSERT INTO Clients_Ledger (LedgerID, ReceiptID, ReceiptBatchID, ClientID, [Date], RefNo, ChargeAccount, PaymentType, Debit, Credit ) " _
                        & "VALUES (" & LedgerID & ", " & .TextMatrix(c, 9) & ", " & PK & ", " & .TextMatrix(c, 8) & ", #" & dtpDate.Value & "#, '" & .TextMatrix(c, 1) & "', '" & .TextMatrix(c, 3) & "' , '" & .TextMatrix(c, 4) & "', 0, " & toNumber(.TextMatrix(c, 5)) & ")"
                        
                If cbPT.ListIndex = 1 Then
                    CN.Execute "INSERT INTO Payments_Checks ( LedgerID, CheckNo, BankID, [Date] ) " _
                            & "VALUES (" & LedgerID & ", " & txtCheckNo.Text & ", " & nsdBank.BoundText & ", Date())"
                End If
            End If
            
        Next c
    End With

    'Clear variables
    c = 0
    
    Set RSDetails = Nothing

    CN.CommitTrans

    HaveAction = True
    Screen.MousePointer = vbDefault

    If State = adStateAddMode Then
        MsgBox "New record has been successfully saved.", vbInformation
        Unload Me

    Else
        MsgBox "Changes in  record has been successfully saved.", vbInformation
        Unload Me
    End If

    Exit Sub
err:
    CN.RollbackTrans
    prompt_err err, Name, "cmdSave_Click"
    Screen.MousePointer = vbDefault
End Sub

Private Sub cmdUsrHistory_Click()
    On Error Resume Next
    Dim tDate1 As String
    Dim tUser1 As String
    
    tDate1 = Format$(rs.Fields("DateAdded"), "MMM-dd-yyyy HH:MM AMPM")
    
    tUser1 = getValueAt("SELECT PK,CompleteName FROM tbl_SM_Users WHERE PK = " & rs.Fields("AddedByFK"), "CompleteName")
    
    MsgBox "Date Added: " & tDate1 & vbCrLf & _
           "Added By: " & tUser1 & vbCrLf & _
           "" & vbCrLf & _
           "Last Modified: n/a" & vbCrLf & _
           "Modified By: n/a", vbInformation, "Modification History"
           
    tDate1 = vbNullString
    tUser1 = vbNullString
End Sub

Private Sub Form_Activate()
    On Error Resume Next
    If CloseMe = True Then Unload Me: Exit Sub
    txtEntry(0).SetFocus
End Sub

Private Sub Form_Load()
    
    'Bind the data combo
    bind_dc "SELECT * FROM Routes", "Desc", dcRoute, "RouteID", True
    bind_dc "SELECT * FROM Agents", "AgentCode", dcBooking, "AgentID", True
    bind_dc "SELECT * FROM Agents", "AgentCode", dcCollection, "AgentID", True

    InitGrid
    InitNSD

    'Check the form state
    If State = adStateAddMode Or State = adStatePopupMode Then
        'Initialize controls
        cbPT.ListIndex = 0

        'Set the recordset
         rs.Open "SELECT * FROM Receipts_Batch WHERE ReceiptBatchID=" & PK, CN, adOpenStatic, adLockOptimistic
         dtpDate.Value = Date
         Caption = "Create New Entry"
         cmdUsrHistory.Enabled = False
         GeneratePK
    Else
        Screen.MousePointer = vbHourglass
        'Set the recordset
        rs.Open "SELECT * FROM qry_Receipts_Batch WHERE ReceiptBatchID=" & PK, CN, adOpenStatic, adLockOptimistic
        
        If State = adStateViewMode Then
            Caption = "Edit Record"
            cmdCancel.Caption = "Close"
            DisplayForViewing
        Else
            Caption = "Edit Record"
            cmdCancel.Caption = "Cancel"
            DisplayForEditing
        End If
        
        cmdUsrHistory.Enabled = True
        
        Screen.MousePointer = vbDefault
    End If
End Sub

'Procedure used to generate PK
Private Sub GeneratePK()
    PK = getIndex("Collection")
    txtEntry(0).Text = "COL" & GenerateID(PK, Format$(Date, "yyyy") & Format$(Date, "mm") & Format$(Date, "dd") & "-", "0")
End Sub

'Procedure used to initialize the grid
Private Sub InitGrid()
    cCRowCount = 0
    With Grid
        .Clear
        .ClearStructure
        .Rows = 2
        .FixedRows = 1
        .FixedCols = 1
        .Cols = 11
        .ColSel = 7
        'Initialize the column size
        .ColWidth(0) = 315
        .ColWidth(1) = 1000
        .ColWidth(2) = 3500
        .ColWidth(3) = 1500
        .ColWidth(4) = 1500
        .ColWidth(5) = 1000
        .ColWidth(6) = 1000
        .ColWidth(7) = 2000
        .ColWidth(8) = 0
        .ColWidth(9) = 0
        .ColWidth(10) = 0
        'Initialize the column name
        .TextMatrix(0, 0) = ""
        .TextMatrix(0, 1) = "OR No"
        .TextMatrix(0, 2) = "Customer Name"
        .TextMatrix(0, 3) = "Charge Account"
        .TextMatrix(0, 4) = "Payment Type"
        .TextMatrix(0, 5) = "Payment"
        .TextMatrix(0, 6) = "Balance"
        .TextMatrix(0, 7) = "Remarks"
        .TextMatrix(0, 8) = "ClientID"
        .TextMatrix(0, 9) = "ReceiptID"
        .TextMatrix(0, 10) = "CollectionDetailID"
        'Set the column alignment
        .ColAlignment(0) = vbLeftJustify
        .ColAlignment(1) = vbLeftJustify
        .ColAlignment(2) = vbLeftJustify
'        .ColAlignment(3) = vbLeftJustify
'        .ColAlignment(4) = vbLeftJustify
'        .ColAlignment(5) = vbLeftJustify
'        .ColAlignment(6) = vbLeftJustify
    End With
End Sub

Private Sub ResetEntry()
    nsdClient.ResetValue
    txtBal.Text = "0.00"
    
    txtPayment.Text = "0.00"
    cbPT.ListIndex = 0
    txtRem.Text = ""
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If HaveAction = True Then
        frmCollection.RefreshRecords
    End If
    
    Set frmCollectionAE = Nothing
End Sub

Private Sub Grid_Click()
    If State = adStateViewMode Then Exit Sub
    
    If Grid.Rows = 2 And Grid.TextMatrix(1, 8) = "" Then '8 = ClientID
        btnRemove.Visible = False
    Else
        btnRemove.Visible = True
        btnRemove.Top = (Grid.CellTop + Grid.Top) - 20
        btnRemove.Left = Grid.Left + 50
    End If
End Sub

Private Sub Grid_Scroll()
    btnRemove.Visible = False
End Sub

Private Sub Grid_SelChange()
    Grid_Click
End Sub

Private Sub nsdClient_Change()
    nsdORNo.sqlwCondition = "ClientID=" & nsdClient.BoundText
    
    txtBal.Text = nsdClient.getSelValueAt(3)
    txtBal.Tag = nsdClient.getSelValueAt(3)
    
    txtPayment.Text = "0.00"
End Sub

Private Sub nsdORNo_Change()
    txtPayment.Text = nsdORNo.getSelValueAt(3)
    
    Dim dDeliveryDate As Date
    
    dDeliveryDate = getValueAt("SELECT LedgerID, Date FROM Clients_Ledger WHERE RefNo = '" & nsdORNo.Text & "'", "Date")
    
    If dtpDate.Value = dDeliveryDate Then
        cbCA.ListIndex = 0
    Else