1. Creating Transactions


1.     On MS Access, create a database named SALES.MDB with the following tables:
Table              Fields
Customers-id,name,address,contactno,creditlimit
Employees-id,name,address,designation
Products-id,description,untmsr,price,qtyonhand
Generators-orderid(put startup value of 1)
Orders-custid,empid,orderdate,totalamount,orderid
OrderDetails-productid,orderid,qtyordered,price,amount
2.     On Project Explorer  create a files as shown below:

3.     Project Reference for MS Access Database
3.1 On the menu bar, click Project->references
3.2 Check Microsoft ActiveX Data Objects 2.6 Library

4.     Create a Sales Order user interface that looks like below:

Textboxes Name
txtCustID
txtOrderID
txtCustName
txtDate
txtAddress

txtProductID
txtDescription
txtUnitMsr
txtPrice
txtQtyOnHand
txtQtyOrdered

txtEmpID
txtRunningTotal
txtEmpName

Listview
   name-lvwOrders
   View-lvwReport
   FullRowSelect-true
   GridLines-true
    Right click Listview->Property Pages->Column Headers Tab-> Type in the column headers above .
5.     On your  Sales Order UI code window, type the following:
Private Sub Form_Load()
        GenerateTransaction()
        SetMaxLength()
    End Sub
    Private Sub Form_Activate()
        Me.txtCustID.SetFocus()
    End Sub
    Private Sub SetMaxLength()
        txtCustID.MaxLength = 4
    End Sub
    Private Sub GenerateTransaction()
        Dim order As New Orders
        Me.txtOrderID.Text = order.GetOrderID
        Me.txtDate.Text = Now
    End Sub

    Private Sub txtCustID_KeyPress(ByVal KeyAscii As Integer)
        If KeyAscii = 13 And txtCustID.Text <> Empty Then
            Dim customer As New Customers

            customer.id = CInt(txtCustID.Text)
            Dim rs As New Recordset

            rs.Open(customer.Search, db)

            If rs.BOF = True And rs.EOF = True Then
                AppToolBox.Message("Customer Not Found.")
                txtCustID.SelStart = 0
                txtCustID.SelLength = Len(txtCustID.Text)
            Else
                Me.txtCustName.Text = rs.Fields("name")
                Me.txtAddress.Text = rs.Fields("address")
                Me.txtProductID.SetFocus()
            End If
        End If
    End Sub

    Private Sub txtProductID_KeyPress(ByVal KeyAscii As Integer)
        If KeyAscii = 27 Then txtEmpID.SetFocus()

        If KeyAscii = 13 And txtProductID.Text <> Empty Then
            Dim product As New Products
            product.id = CInt(txtProductID.Text)
            Dim rs As New Recordset

            rs.Open(product.Search, db)

            If rs.BOF And rs.EOF Then
                AppToolBox.Message("Product Not Found.")
                txtProductID.SelStart = 0
                txtProductID.SelLength = Len(txtProductID.Text)
            Else
                Me.txtDescription.Text = rs.Fields("description")
                Me.txtUnitMsr.Text = rs.Fields("untmsr")
                Me.txtPrice.Text = Format(rs.Fields("price"), "#,##0.00")
                Me.txtQtyOnHand.Text = rs.Fields("qtyonhand")
                Me.txtQtyOrdered.SetFocus()
            End If


        End If
    End Sub

    Private Sub txtQtyOrdered_KeyPress(ByVal KeyAscii As Integer)

        If KeyAscii = 13 And txtQtyOrdered.Text <> Empty Then

            If CInt(txtQtyOrdered.Text) <= CInt(Me.txtQtyOnHand.Text) Then
                AddProductToList()
                Me.txtRunningTotal.Text = Format(ComputeRunningTotal, "#,##0.00")
                ResetProductEntry()
            Else
                AppToolBox.Message("Insufficient Quantity.")
            End If

        End If
    End Sub

    Private Sub ResetProductEntry()
        Me.txtProductID.Text = Empty
        Me.txtDescription.Text = Empty
        Me.txtQtyOnHand.Text = Empty
        Me.txtPrice.Text = Empty
        Me.txtQtyOrdered.Text = Empty
        Me.txtProductID.SetFocus()
    End Sub

    Private Sub AddProductToList()
        product = Me.lvwOrders.ListItems.add(, , Me.txtProductID.Text)
        With product
            .SubItems(1) = Me.txtDescription.Text
            .SubItems(2) = Me.txtUnitMsr.Text
            .SubItems(3) = Format(Me.txtPrice.Text, "#,##0.00")
            .SubItems(4) = Me.txtQtyOrdered.Text
            .SubItems(5) = Format(CInt(Me.txtQtyOrdered.Text) * CCur(Me.txtPrice.Text), "#,##0.00")
        End With
    End Sub

    Private Function ComputeRunningTotal() As Currency
        For i = 1 To lvwOrders.ListItems.Count
            ComputeRunningTotal = ComputeRunningTotal + CCur(Me.lvwOrders.ListItems(i).SubItems(5))
        Next
    End Function

    Private Sub txtEmpID_KeyPress(ByVal KeyAscii As Integer)
        If KeyAscii = 13 And txtEmpID.Text <> Empty Then
            Dim employee As New Employees

            employee.id = CInt(txtEmpID.Text)
            Dim rs As New Recordset

            rs.Open(employee.Search, db)

            If rs.BOF = True And rs.EOF = True Then
                AppToolBox.Message("Customer Not Found.")
                txtEmpID.SelStart = 0
                txtEmpID.SelLength = Len(txtEmpID.Text)
            Else
                Me.txtEmpName.Text = rs.Fields("name")
            End If
        End If
    End Sub

    Private Sub btnSave_Click()

        Dim transaction As New Transactions
        transaction.add(OrderSQL)

        For i = 1 To lvwOrders.ListItems.Count
            transaction.add(OrderDetailSQL(i))
            transaction.add(DeductQtyOnHandSQL(i))
        Next
        transaction.add(DeductCustomerCreditLimitSQL)
        transaction.add(UpdateOrderIDSQL)
        transaction.ExecuteSQLArray()
        AppToolBox.Message("Successfully Save...")
        Call Reset()
    End Sub

    Private Sub Reset()
        AppToolBox.Reset(Me)
        Me.lvwOrders.ListItems.Clear()
       GenerateTransaction
     Me.txtCustID.SetFocus
    End Sub
   
    Private Function UpdateOrderIDSQL() As String
        Dim order As New Orders
        UpdateOrderIDSQL = order.CreateUpdateSQL
    End Function

    Private Function OrderDetailSQL(ByVal i As Integer) As String
        Dim orderdetail As New OrderDetails
        With orderdetail
            .OrderID = CInt(txtOrderID.Text)
            .productid = lvwOrders.ListItems(i).Text
            .Price = lvwOrders.ListItems(i).SubItems(3)
            .qtyordered = lvwOrders.ListItems(i).SubItems(4)
            .Amount = lvwOrders.ListItems(i).SubItems(5)
            OrderDetailSQL = .CreateInsertSQL
        End With
    End Function

    Private Function DeductQtyOnHandSQL(ByVal i As Integer) As String
        Dim product As New Products
        Dim productid As Integer
        Dim qtyordered As Double
        productid = lvwOrders.ListItems(i).Text
        qtyordered = lvwOrders.ListItems(i).SubItems(4)
        DeductQtyOnHandSQL = product.CreateUpdateSQL(productid, qtyordered)
    End Function

    Private Function DeductCustomerCreditLimitSQL() As String
        Dim customer As New Customers
        Dim id As String
        Dim totalorder As Double
        id = CInt(Me.txtCustID.Text)
        totalorder = CDbl(Me.txtRunningTotal.Text)
        DeductCustomerCreditLimitSQL = customer.CreateUpdateSQL(id, totalorder)
    End Function

    Private Function OrderSQL() As String
        Dim order As New Orders
        With order
            .OrderID = CInt(txtOrderID.Text)
            .CustID = CInt(txtCustID.Text)
            .EmpID = CInt(txtEmpID.Text)
            .OrderDate = CDate(txtDate.Text)
            .totalamount = CCur(Me.txtRunningTotal.Text)
            OrderSQL = .CreateInsertSQL
        End With
    End Function

    Private Sub btnReset_Click()
        Call Reset()
    End Sub
    Private Sub btnClose_Click()
        Unload Me
    End Sub
6.     On AppToolBox.bas code window type the following:
Public Sub Reset(ByVal obj As Object)
        Dim ndx As Control
        With obj
            For Each ndx In obj
                If TypeOf ndx Is TextBox Then
                    ndx = Empty
                End If
            Next
        End With
    End Sub

    Public Function IsEmpty(ByVal obj As Object) As Boolean
        IsEmpty = False
        Dim ndx As Control
        With obj
            For Each ndx In obj
                If TypeOf ndx Is TextBox Then
                    If ndx = Empty Then
                        IsEmpty = True
                        Exit Function
                    End If
                End If
            Next
        End With
    End Function

    Public Sub Message(ByVal msg As String)
        MsgBox(msg, vbInformation, "Program Assistant")
    End Sub
7.     On Dbs.bas code window type the following:
  Public db As New Connection
    Public Sub OpenConnection()
        If db.State = 1 Then db.Close()
        db.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                                     & "Data Source=" & App.Path & "\Database\SALES.mdb"
        db.Open(db.ConnectionString)
    End Sub

    Public Sub Execute(ByVal sql As String)
        db.Execute (sql)
    End Sub

    Public Sub CloseConnection()
        db.Close()
    End Sub
8.     On Customers.cls  code window type the following:
   Option Explicit
    'Data members
    Private mID As Integer
    Private mName As String
    Private mAddress As String
    Private mContactNo As String
    Private mCreditLimit As String
    'Setters and Getters
Public Property Get id() As Integer
    id = mID
    End Property

Public Property Let id(ByVal vNewValue As Integer)
    mID = vNewValue
    End Property

Public Property Get Name() As String
    Name = mName
    End Property

Public Property Let Name(ByVal vNewValue As String)
    mName = vNewValue
    End Property

Public Property Get Address() As String
    Address = mAddress
    End Property

Public Property Let Address(ByVal vNewValue As String)
    mAddress = vNewValue
    End Property

Public Property Get ContactNo() As String
    ContactNo = mContactNo
    End Property

Public Property Let ContactNo(ByVal vNewValue As String)
    mContactNo = vNewValue
    End Property

Public Property Get CreditLimit() As Currency
    CreditLimit = mCreditLimit
    End Property

Public Property Let CreditLimit(ByVal vNewValue As Currency)
    mCreditLimit = vNewValue
    End Property
    Public Sub Insert()
        Dim sql As String
        sql = "INSERT INTO Customers(id,name,address,contactno,creditlimit)" _
                & "VALUES('" & id & "', " _
                & " '" & Name & "', " _
                & " '" & Address & "'," _
                & " '" & ContactNo & "'," _
                & " '" & CreditLimit & "')"
        dbs.Execute(sql)
    End Sub

    Public Sub Update()
        Dim sql As String
        sql = "UPDATE Customers SET " _
            & "name='" & Name & "', " _
            & "address='" & Address & "', " _
            & "contactno='" & ContactNo & "'," _
            & "creditlimit='" & CreditLimit & "' " _
            & " WHERE id=" & id & ""
        dbs.Execute(sql)
    End Sub
    Public Sub Delete(ByVal id As Integer)
        Dim sql As String
        sql = "DELETE FROM Customers WHERE id=" & id & ""
        dbs.Execute(sql)
    End Sub

    Public Function Search() As String
        Search = "SELECT * FROM Customers WHERE id=" & id & ""
    End Function
    Public Function CreateUpdateSQL(ByVal id As Integer, ByVal totalamount As Double) As String
        Dim sql As String
        CreateUpdateSQL = "UPDATE Customers SET creditlimit=creditlimit-'" & totalamount & "'" _
                                            & "WHERE id=" & id & ""
    End Function
    Private Sub Class_Initialize()
        dbs.OpenConnection()
    End Sub

9.     On Employees.cls  code window type the following:
Option Explicit
    'Data members
    Private mID As Integer
    Private mName As String
    Private mAddress As String
    Private mDesignation As String
Public Property Get id() As Integer
id = mID
    End Property

Public Property Let id(ByVal vNewValue As Integer)
mID = vNewValue
    End Property
Public Property Get Name() As String
    Name = mName
    End Property

Public Property Let Name(ByVal vNewValue As String)
    mName = vNewValue
    End Property

Public Property Get Address() As String
    Address = mAddress
    End Property

Public Property Let Address(ByVal vNewValue As String)
    mAddress = vNewValue
    End Property


Public Property Get Designation() As String
    Designation = mDesignation
    End Property


Public Property Let Designation(ByVal vNewValue As String)
    mDesignation = vNewValue
    End Property

    Public Sub Insert()
        Dim sql As String
        sql = "INSERT INTO Employees(id,name,address,designation)" _
                & "VALUES('" & id & "', " _
                & " '" & Name & "', " _
                & " '" & Address & "'," _
                & " '" & Designation & "')"
        ExecuteQuery(sql)

    End Sub

    Public Sub Update()
        Dim sql As String
        sql = "UPDATE Employees SET " _
            & "name='" & Name & "', " _
            & "address='" & Address & "', " _
            & "designation='" & Designation & "' " _
            & " WHERE id=" & id & ""
        ExecuteQuery(sql)
    End Sub
    Public Sub Delete(ByVal id As Integer)
        Dim sql As String
        sql = "DELETE FROM Employees WHERE id=" & id & ""
        ExecuteQuery(sql)
    End Sub

    Private Sub ExecuteQuery(ByVal sql As String)
        dbs.Execute(sql)
        dbs.CloseConnection()
    End Sub

    Private Sub Class_Initialize()
        dbs.OpenConnection()
    End Sub

    Public Function Search() As String
        Search = "SELECT * FROM Employees WHERE id=" & id & ""
    End Function
10.   On Products.cls  code window type the following:
Option Explicit
    'Data members
    Private mID As Integer
    Private mDescription As String
    Private mUntmsr As String
    Private mPrice As Currency
    Private mQtyonhand As Integer

Public Property Get id() As Integer
id = mID
    End Property

Public Property Let id(ByVal vNewValue As Integer)
mID = vNewValue
    End Property
Public Property Get Description() As String
    Description = mDescription
    End Property

Public Property Let Description(ByVal vNewValue As String)
    mDescription = vDescription
    End Property

Public Property Get Untmsr() As String
    Untmsr = mUntmsr
    End Property

Public Property Let Untmsr(ByVal vNewValue As String)
    mUntmsr = vNewValue
    End Property

Public Property Get Price() As Currency
    Price = mPrice
    End Property

Public Property Let Price(ByVal vNewValue As Currency)
    mPrice = vNewValue
    End Property

Public Property Get QtyOnHand() As Integer
QtyOnHand = mQtyonhand
    End Property

Public Property Let QtyOnHand(ByVal vNewValue As Integer)
mQtyonhand = vNewValue
    End Property


    Public Sub Insert()
        Dim sql As String
        sql = "INSERT INTO Products(id,description,untmsr,price,qtyonhand)" _
                & "VALUES('" & id & "', " _
                & " '" & Description & "', " _
                & " '" & Untmsr & "'," _
                & " '" & Price & "'," _
                & " '" & QtyOnHand & "')"
        ExecuteQuery(sql)

    End Sub

    Public Sub Update()
        Dim sql As String
        sql = "UPDATE Products SET " _
            & "description='" & Description & "', " _
            & "untmsr='" & Untmsr & "', " _
            & "price='" & Price & "', " _
            & "qtyonhand='" & QtyOnHand & "' " _
            & " WHERE id=" & id & ""
        ExecuteQuery(sql)
    End Sub

    Public Sub Delete(ByVal id As Integer)
        Dim sql As String
        sql = "DELETE FROM Products WHERE id=" & id & ""
        ExecuteQuery(sql)
    End Sub

    Private Sub ExecuteQuery(ByVal sql As String)
        dbs.Execute(sql)
        dbs.CloseConnection()
    End Sub

    Private Sub Class_Initialize()
        dbs.OpenConnection()
    End Sub
    Public Function CreateUpdateSQL(ByVal pid As Integer, ByVal qtyordered As Double) As String
        CreateUpdateSQL = "UPDATE Products SET qtyonhand=qtyonhand-'" & qtyordered & "'" _
                                            & "WHERE id=" & pid & ""
    End Function

    Public Function Search() As String
        Search = "SELECT * FROM Products WHERE id=" & id & ""
    End Function
11.   On Orders.cls  code window type the following:
Private mOrderID As Long
    Private mCustID As Integer
    Private mEmpID As Integer
    Private mOrderDate As Date
    Private mTotalAmount As Currency
Public Property Get OrderID() As Long
OrderID = mOrderID
    End Property

Public Property Let OrderID(ByVal vNewValue As Long)
mOrderID = vNewValue
    End Property
Public Property Get CustID() As Integer
    CustID = mCustID
    End Property

Public Property Let CustID(ByVal vNewValue As Integer)
    mCustID = vNewValue
    End Property

Public Property Let EmpID(ByVal vNewValue As Integer)
    mEmpID = vNewValue
    End Property

Public Property Get EmpID() As Integer
    EmpID = mEmpID
    End Property

Public Property Let OrderDate(ByVal vNewValue As Date)
    mOrderDate = vNewValue
    End Property

Public Property Get OrderDate() As Date
    OrderDate = mOrderDate
    End Property

Public Property Let totalamount(ByVal vNewValue As Currency)
    mTotalAmount = vNewValue
    End Property

Public Property Get totalamount() As Currency
    totalamount = mTotalAmount
    End Property

    Public Function GetOrderID() As Integer
        Dim sql As String
        sql = "SELECT orderid FROM Generators"
        Dim rs As New Recordset
        rs.Open(sql, db)

        GetOrderID = rs.Fields("orderid")
    End Function

    Private Sub Class_Initialize()
        dbs.OpenConnection()
    End Sub

    Public Function CreateUpdateSQL()
        CreateUpdateSQL = "UPDATE Generators SET orderid=orderid+1"
    End Function

    Public Function CreateInsertSQL()
        CreateInsertSQL = "INSERT INTO Orders(orderid,orderdate,custid,empid,totalamount)" _
                & "VALUES('" & OrderID & "', " _
                & " '" & OrderDate & "', " _
                & " '" & CustID & "'," _
                & " '" & EmpID & "'," _
                & " '" & totalamount & "')"
    End Function
12.   On OrderDetails.cls  code window type the following:
Private mOrderID As Long
    Private mProductID As Integer
    Private mQtyOrdered As Integer
    Private mPrice As Currency
    Private mAmount As Currency
Public Property Get OrderID() As Long
OrderID = mOrderID
    End Property

Public Property Let OrderID(ByVal vNewValue As Long)
mOrderID = vNewValue
    End Property
Public Property Get productid() As Integer
productid = mProductID
    End Property

Public Property Let productid(ByVal vNewValue As Integer)
mProductID = vNewValue
    End Property

Public Property Get qtyordered() As Integer
qtyordered = mQtyOrdered
    End Property

Public Property Let qtyordered(ByVal vNewValue As Integer)
mQtyOrdered = vNewValue
    End Property

Public Property Get Price() As Currency
Price = mPrice
    End Property

Public Property Let Price(ByVal vNewValue As Currency)
mPrice = vNewValue
    End Property

Public Property Get Amount() As Currency
Amount = mAmount
    End Property

Public Property Let Amount(ByVal vNewValue As Currency)
mAmount = vNewValue
End Property


Public Function CreateInsertSQL()
        CreateInsertSQL = "INSERT INTO OrderDetails(orderid,productid,price,qtyordered,amount)" _
                & "VALUES('" & OrderID & "', " _
                & " '" & productid & "', " _
                & " '" & Price & "'," _
                & " '" & qtyordered & "'," _
                & " '" & Amount & "')"
End Function
13.   On Transactions.cls  code window type the following:
Private SQLArrayToExecute(0 To 100) As String
    Private ndx As Integer

    Public Sub add(ByVal sql As String)
        SQLArrayToExecute(ndx) = sql
        ndx = ndx + 1
    End Sub

    Public Sub ExecuteSQLArray()
        db.BeginTrans()
        For i = 0 To ndx - 1
            dbs.Execute(SQLArrayToExecute(i))
        Next
        db.CommitTrans()
    End Sub

Debugging your code
-To familiarize the behaviour of the language or to know how your codes are executed in sequence, debugging should be done. In visual basic, just put a break point by clicking at the left margin of the procedure or function and then press F8. To break the debugging mode, just click the end button at the right of the start button in the toolbar and to remove the break point, just click the break point to toggle.

Congrats, you made it-mariuz the farmer:)


No comments:

Post a Comment

Subscribe to: Post Comments (Atom)