Example Application: Calling an External Application (FunDS)

	Example Application: Calling an External Application - FunDS (Fun Department Store)

Introduction

Microsoft Access is a wonderful aplication. It is used to create databases for various types of scenarios. Like any application, Microsoft Access has its limitations, or sometimes some things are difficult to do.

Sometimes there is a different or better way to solve a problem using a different programming environment or a different language other than VBA. In this example, we will create a small application using the (modern) Visual Basic language to access some tables from a Microsoft Access database.

Practical Learning: Introducing the Application

Start Microsoft Access
Click Blank Desktop Database
In the File Name section, click the yellow button
In the left list, click the C: drive to select it
Click the New Folder button to create a new folder
Type FunDS (DS stands for department store) and press Enter
Display the new folder in the top combo box
Change the File Name to FunDS1
Click OK
Click Create
On the Ribbon, click File -> Options
On the left list, click Current Database
Click Overlapping Windows and Compact On Close
Click OK
Click OK
Close Microsoft Access and re-open it with the FunDS database
On the Ribbon, click Create
In the Tables section, click Table Design

Create the columns as follows:

Field Name	Data Type	Field Size	Caption
EmployeeNumber	Short Text	10	Employee #
FirstName	Short Text	25	First Name
LastName	Short Text	25	Last Name
Title	Short Text	50

In the top section, right-click EmployeeNumber and click Primary Key
Close the form
When asked whether you want to save, click Yes
Set the name to Employees and press Enter
On the Ribbon, click Create and, in the Forms section, click Form Design
Using the Properties window, set the following characteristics:
Record Source: Employees
Auto Center: Yes
Save the form as Employees
Design it as follows:
Save and close the Employees form
On the Ribbon, click Create
In the Tables section, click Table Design
Create the column as follows:

Field Name Data Type Field Size Caption

Manufacturer Short Text 40 Employee #
In the top section, right-click Manufacturer and click Primary Key
Close the table
When asked whether you want to save, click Yes
Set the name to Manufacturers and click OK
On the Ribbon, click CREATE and, in the Forms section, click Form Design
Using the Properties window, set the following characteristics:
Record Source: Manufacturers
Auto Center: Yes
Save the form as Manufacturers
Design it as follows:
Save and close the Manufacturers form
On the Ribbon, click Create and, in the Forms section, click Form Design
Using the Properties window, set the following characteristics:
Caption: Fun Department Stores - New Manufacturer
Auto Center: Yes
Navigation Buttons: No
Save the form as NewManufacturer
Design it as follows:

Set the codes of the Submit and Close buttons as follows:

Private Sub cmdSubmit_Click()
    If IsNull(Manufacturer) Or IsEmpty(Manufacturer) Then
        MsgBox "You must provide a manufacturer.", vbOKOnly Or vbInformation, "Fun Department Store"
        Exit Sub
    End If
    
    DoCmd.RunSQL "INSERT INTO Manufacturers VALUES('" & Manufacturer & "');"
    DoCmd.Close
End Sub

Private Sub cmdClose_Click()

    DoCmd.Close

End Sub

Save and close the ManufacturerNew form
On the Ribbon, click Create and, in the Tables section, click Table Design
Under Field Name, type Category and press F6
Set the Field Size to 40
In the top section, right-click Category and click Primary Key
Close the table
When asked whether you want to save the table, click Yes
Set the name to Categories and press Enter
On the Ribbon, click Create and, in the Forms section, click Form Design
Using the Properties window, set the following properties:
Record Source: Categories
Auto Center: Yes
Save the form as Categories
Design it as follows:
Save and close the Categories form
On the Ribbon, click Create and, in the Forms section, click Form Design
Using the Properties window, set the following characteristics:
Caption: Fun Department Stores - New Category
Auto Center: Yes
Navigation Buttons: No
Save the form as NewCategory
Design it as follows:

Se the code of the buttons as follows:

Private Sub cmdSubmit_Click()
    If IsNull(Category) Or IsEmpty(Category) Then
        MsgBox "You must provide a Category.", vbOKOnly Or vbInformation, "Fun Department Store - New Category"
        Exit Sub
    End If
    
    DoCmd.RunSQL "INSERT INTO Categories VALUES('" & Category & "');"
    DoCmd.Close
End Sub

Private Sub cmdClose_Click()

    DoCmd.Close

End Sub

Save and close the CategoryNew form
On the Ribbon, click Create and, in the Tables section, click Table Design
Under Field Name, type SubCategory and, in the bottom section, change the Field Size to 40
Set the Caption to Sub-Category
In the top section, right-click SubCategory and click Primary Key
Close the table and save it as SubCategories when prompted
On the Ribbon, click Create and, in the Forms section, click Form Design
Using the Properties window, set the following characteristics:
Record Source: SubCategories
Auto Center: Yes
Save the form as SubCategories
Design it as follows:
Save the Sub-Categories form
On the Ribbon, click Create and, in the Forms section, click Form Design
Using the Properties window, set the following characteristics:
Caption: Fun Department Stores - New Sub-Category
Auto Center: Yes
Navigation Buttons: No
Save the form as NewSubCategory
Design it as follows:

Se the code of the buttons as follows:

Private Sub cmdSubmit_Click()
    If IsNull(SubCategory) Or IsEmpty(SubCategory) Then
        MsgBox "You must provide a sub-category.", vbOKOnly Or vbInformation, "Fun Department Store - New Sub-Category"
        Exit Sub
    End If
    
    DoCmd.RunSQL "INSERT INTO SubCategories VALUES('" & SubCategory & "');"
    DoCmd.Close
End Sub

Private Sub cmdClose_Click()

    DoCmd.Close

End Sub

Save and close the CategoryNew form
On the Ribbon, click Create
In the Tables section, click Table Design

Create the columns as follows:

Field Name	Data Type	Field Size	Format	Caption
ItemNumber	Short Text	10		Item #
Manufacturer	Short Text	40
Category	Short Text	40
SubCategory	Short Text	40		Sub-Category
ItemName	Short Text	100		Item Name
ItemSize	Short Text	25		Item Size
UnitPrice	Number	Double	Fixed	Unit Price
DiscountRate	Number	Double	Fixed	Discount Rate

In the top section, right-click ItemNumber and click Primary Key
Close the table
When asked whether you want to save, click Yes
Set the name to StoreItems and click OK
On the Ribbon, click Create and, in the Forms section, click Form Design
Using the Properties window, set the following characteristics:
Record Source: StoreItems
Auto Center: Yes
Save the form as StoreItems
In the Design section of the Ribbon, click the Combo Box and click the form
In the first page of the Combo Box Wizard, make sure the first radio button is selected and click Next
In the second page of the wizard, click Table: Manufacturers and click Next
In the third page, double-click Manufacturer and click Next
Click Next
Click Next
In the Store That Value In The Field combo box, select Manufacturer
Click Finish
Add another combo box and select the Category field of the Categories table and set it for the Store That Value In The Field combo box
Add another combo box and select the SubCategory field of the SubCategories table and set it for the Store That Value In The Field combo box
Design it as follows:
Save and close the StoreItems form
In the Navigation Pane, right-click StoreItems and click Copy
Right-click an empty area of the Navigation Pane and click Paste
Set the name to NewStoreItem and press Enter
In the Navigation Pane, right-click StoreItemNew and click Design View
In the Properties window, delete the value in the Record Source field
Set the following characteristics:
Caption: Fun Department Stores - New Store Item
Auto Center: Yes
Navigation Buttons: No
Design the form as follows:

Set the codes of the buttons as follows:

Private Sub Form_Load()
    ItemNumber = CLng((Rnd() * 1000000))
End Sub

Private Sub cmdNewManufacturer_Click()
    DoCmd.OpenForm "NewManufacturer", , , , acFormAdd, AcWindowMode.acDialog
    Me.Refresh
End Sub

Private Sub cmdNewCategory_Click()
On Error GoTo cmdNewCategory_Error
    
    DoCmd.OpenForm "NewCategory", , , , acFormAdd, AcWindowMode.acDialog
    
    Me.Refresh
    
cmdNewSubCategory_Exit:
    Exit Sub
    
cmdNewCategory_Error:
    MsgBox "An error occured when trying to update the list." & vbCrLf & _
           "=- Please report the error as follows -=" & vbCrLf & _
           "Error #: " & Err.Number & vbCrLf & _
           "Error Message: " & Err.Description
           Resume cmdNewSubCategory_Exit
End Sub

Private Sub cmdNewSubCategory_Click()
On Error GoTo cmdNewSubCategory_Error
    
    DoCmd.OpenForm "NewSubCategory", , , , acFormAdd, AcWindowMode.acDialog
    
    Me.Refresh
    
cmdNewSubCategory_Exit:
    Exit Sub
    
cmdNewSubCategory_Error:
    MsgBox "An error occured when trying to update the list." & vbCrLf & _
           "=- Please report the error as follows -=" & vbCrLf & _
           "Error #: " & Err.Number & vbCrLf & _
           "Error Message: " & Err.Description
           Resume cmdNewSubCategory_Exit
End Sub

Private Sub cmdSubmit_Click()
On Error GoTo cmdSubmit_Error
    Dim dbCurrent As Database
    Dim rsStoreItems As Recordset
    
    If IsNull(ItemNumber) Or IsEmpty(ItemNumber) Then
        MsgBox "You must provide an item number.", vbOKOnly Or vbInformation, "Fun Department Store"
        Exit Sub
    End If
    
    If IsNull(ItemName) Or IsEmpty(ItemName) Then
        MsgBox "You must supply the name of the item.", vbOKOnly Or vbInformation, "Fun Department Store"
        Exit Sub
    End If
    
    If IsNull(UnitPrice) Or IsEmpty(UnitPrice) Then
        MsgBox "You must provide the price of the item.", vbOKOnly Or vbInformation, "Fun Department Store"
        Exit Sub
    End If
    
    Set dbCurrent = CurrentDb
    Set rsStoreItems = dbCurrent.OpenRecordset("StoreItems")
    
    rsStoreItems.AddNew
    rsStoreItems("ItemNumber").Value = ItemNumber
    rsStoreItems("ItemName").Value = ItemName
    rsStoreItems("UnitPrice").Value = CDbl(UnitPrice)
    rsStoreItems.Update
    
    Set rsStoreItems = dbCurrent.OpenRecordset("SELECT Manufacturer, Category, SubCategory, ItemName, ItemSize, UnitPrice, DiscountRate " & _
                                               "FROM StoreItems " & _
                                               "WHERE ItemNumber = '" & ItemNumber & "';")
    
    If Manufacturer <> "" Then
        rsStoreItems.Edit
        rsStoreItems("Manufacturer").Value = Manufacturer
        rsStoreItems.Update
    End If
    
    If Category <> "" Then
        rsStoreItems.Edit
        rsStoreItems("Category").Value = Category
        rsStoreItems.Update
    End If
    
    If SubCategory <> "" Then
        rsStoreItems.Edit
        rsStoreItems("SubCategory").Value = SubCategory
        rsStoreItems.Update
    End If
    
    If ItemSize <> "" Then
        rsStoreItems.Edit
        rsStoreItems("ItemSize").Value = ItemSize
        rsStoreItems.Update
    End If
    
    If DiscountRate <> "" Then
        rsStoreItems.Edit
        rsStoreItems("DiscountRate").Value = CDbl(DiscountRate)
        rsStoreItems.Update
    End If
    
    ItemNumber = CLng((Rnd() * 1000000))
    Manufacturer = ""
    Category = ""
    SubCategory = ""
    ItemName = ""
    ItemSize = ""
    UnitPrice = "0.00"
    DiscountRate = ""
    
    Set rsStoreItems = Nothing
    Set dbCurrent = Nothing
    
cmdSubmit_Exit:
    Exit Sub

cmdSubmit_Error:
    MsgBox "An error occured when trying to create a new store item." & vbCrLf & _
           "=- Please report the error as follows -=" & vbCrLf & _
           "Error #: " & Err.Number & vbCrLf & _
           "Error Message: " & Err.Description, vbOKOnly Or vbInformation, "Fun Department Store"
    Resume cmdSubmit_Exit
End Sub

Private Sub cmdClose_Click()

    DoCmd.Close

End Sub

Save and close the StoreItemNew form
On the Ribbon, click Create
In the Tables section, click Table Design

Create the columns as follows:

Field Name	Data Type	Field Size	Format	Caption
ReceiptNumber	Number	Long Integer		Receipt #
EmployeeNumber	Short Text	10		Employee #
SaleDate	Short Text	50		Sale Date
SaleTime	Short Text	20		Sale Time
OrderTotal	Number	Double	Fixed	Order Total
AmountTendered	Number	Double	Fixed	Amount Tendered
Change	Number	Double	Fixed

In the top section, right-click ReceiptNumber and click Primary Key
Close the table
When asked whether you want to save, click Yes
Set the name to StoreSales and click OK
On the Ribbon, click Create
In the Tables section, click Table Design

Create the columns as follows:

Field Name	Data Type	Field Size	Format	Caption
SoldItemID	AutoNumber			Sold Item ID
ReceiptNumber	Number	Long Integer		Receipt #
ItemNumber	Number	Long Integer		Item #
ItemName	Short Text	100		Item Name
ItemSize	Short Text	25		Item Size
UnitPrice	Number	Double	Fixed	Unit Price
DiscountRate	Number	Double	Fixed	Discount Rate
DiscountAmount	Number	Double	Fixed	Discount Amount
SalePrice	Number	Double	Fixed	Sale Price

In the top section, right-click ReceiptNumber and click Primary Key
Close the table
When asked whether you want to save, click Yes
Set the name to SoldItems and click OK
On the Ribbon, click Create and, in the Forms section, click Form Design
Using the Properties window, set the following characteristics:
Record Source: SoldItems
Default View: Continuous Forms
Navigation Buttons: No
Right-click the form and click Form Header/Footer
Click the Form Footer bar and, in the Properties window, set its Visible field to No
Save the form as sfSoldItems
Design it as follows:
Save and close the form

Handling Shopping Sessions in Visual Basic

A shopping session consists of a customer buying items from a store. To take of shopping, we will use a form. To start, an employee (or clerk) must be identified so we would know who handled the transaction. Each item in the store has a unite number (called an item number), a name (as a short description a size (or item size), and a unit price. Some items can also be on sale. When an item is not on sale, it is sold at normal or full price. When an item is on sale, a discount rate applies. When a discount rate applies, we will calculate the discount amount, then the sale price will be deducted from that. In a receipt, we will show all these values.

Practical Learning: Handling Shopping Sessions

Start a text editor such as Notepad and type the following code in it:

Imports System
Imports System.IO
Imports System.Data
Imports System.Drawing
Imports System.Data.OleDb
Imports System.Windows.Forms

Public Class ShoppingSession
    Inherits Form
    Dim lblItemNumberSelected As Label
    Friend WithEvents txtItemNumberSelected As TextBox
    Dim lblReceiptNumber As Label
    Dim txtReceiptNumber As TextBox

    Dim colItemNumber As ColumnHeader
    Dim colItemName As ColumnHeader
    Dim colItemSize As ColumnHeader
    Dim colUnitPrice As ColumnHeader
    Dim colDiscountRate As ColumnHeader
    Dim colDiscountAmount As ColumnHeader
    Dim colSalePrice As ColumnHeader
    Dim lvwSelectedItems As ListView

    Friend WithEvents txtEmployeeNumber As TextBox
    Dim lblEmployeeNumber As Label
    Dim dtpSaleDate As DateTimePicker
    Dim lblSaleTime As Label
    Friend WithEvents txtAmountTendered As TextBox
    Dim lblTendered As Label
    Dim txtChange As TextBox
    Dim lblChange As Label
    Dim txtOrderTotal As TextBox
    Dim lblOrderTotal As Label
    Dim txtEmployeeName As TextBox
    Dim txtItemNumberRemove As TextBox
    Dim lblItemNumberToRemove As Label
    Friend WithEvents btnRemoveItem As Button
    Friend WithEvents btnSubmit As Button
    Friend WithEvents btnReset As Button
    Friend WithEvents btnClose As Button

    Friend WithEvents tmrDateTime As Timer

    Private strFilePath As String

    Public Sub New()
        InitializeComponent()
    End Sub

    Private Sub InitializeComponent()
        ' Label: Item Number to Add
        lblItemNumberSelected = New Label()
        lblItemNumberSelected.AutoSize = True
        lblItemNumberSelected.Font = New System.Drawing.Font("Georgia", 20.25F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        lblItemNumberSelected.Location = New Point(16, 22)
        lblItemNumberSelected.TabIndex = 2
        lblItemNumberSelected.Text = "Item # to Add:"
        Controls.Add(lblItemNumberSelected)

        '  Text Box: Item Number to Add
        txtItemNumberSelected = New TextBox()
        txtItemNumberSelected.Font = New System.Drawing.Font("Times New Roman", 21.75F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        txtItemNumberSelected.Location = New Point(235, 18)
        txtItemNumberSelected.Size = New System.Drawing.Size(155, 41)
        txtItemNumberSelected.TabIndex = 3
        Controls.Add(txtItemNumberSelected)

        '  Label: Receipt Number
        lblReceiptNumber = New Label()
        lblReceiptNumber.AutoSize = True
        lblReceiptNumber.Font = New System.Drawing.Font("Georgia", 20.25F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        lblReceiptNumber.Location = New Point(1081, 22)
        lblReceiptNumber.TabIndex = 5
        lblReceiptNumber.Text = "Receipt #:"
        Controls.Add(lblReceiptNumber)

        '  Text Box: Receipt Number
        txtReceiptNumber = New TextBox()
        txtReceiptNumber.Font = New System.Drawing.Font("Times New Roman", 21.75F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        txtReceiptNumber.Location = New Point(1260, 18)
        txtReceiptNumber.Size = New System.Drawing.Size(105, 41)
        txtReceiptNumber.TabIndex = 6
        Controls.Add(txtReceiptNumber)

        '  Column: umn: Item Number
        colItemNumber = New ColumnHeader()
        colItemNumber.Text = "Item #"
        colItemNumber.Width = 100

        '  Column: umn: Item Name
        colItemName = New ColumnHeader()
        colItemName.Text = "Item Name/Description"
        colItemName.Width = 610

        '  Column: umn: Item Size
        colItemSize = New ColumnHeader()
        colItemSize.Text = "Size"
        colItemSize.Width = 150

        '  Column: umn: Unit Price
        colUnitPrice = New ColumnHeader()
        colUnitPrice.Text = "Unit Price"
        colUnitPrice.TextAlign = HorizontalAlignment.Right
        colUnitPrice.Width = 140

        '  Column: umn: Discount Rate
        colDiscountRate = New ColumnHeader()
        colDiscountRate.Text = "Dscnt Rt"
        colDiscountRate.TextAlign = HorizontalAlignment.Right
        colDiscountRate.Width = 120

        '  Column: umn: Discount Amount
        colDiscountAmount = New ColumnHeader()
        colDiscountAmount.Text = "Dscnt Amt"
        colDiscountAmount.TextAlign = HorizontalAlignment.Right
        colDiscountAmount.Width = 140

        '  Column: umn: Sale Price
        colSalePrice = New ColumnHeader()
        colSalePrice.Text = "Sale Price"
        colSalePrice.TextAlign = HorizontalAlignment.Right
        colSalePrice.Width = 130

        '  List View: Selected Items
        lvwSelectedItems = New ListView()
        lvwSelectedItems.Columns.AddRange(New ColumnHeader() {colItemNumber, colItemName, colItemSize, colUnitPrice, colDiscountRate, colDiscountAmount, colSalePrice})
        lvwSelectedItems.Font = New System.Drawing.Font("Times New Roman", 20.25F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        lvwSelectedItems.FullRowSelect = True
        lvwSelectedItems.GridLines = True
        lvwSelectedItems.Location = New Point(16, 71)
        lvwSelectedItems.Size = New System.Drawing.Size(1424, 321)
        lvwSelectedItems.TabIndex = 8
        lvwSelectedItems.View = View.Details
        Controls.Add(lvwSelectedItems)

        '  Date/Time Picker: Sale Date
        dtpSaleDate = New DateTimePicker()
        dtpSaleDate.Font = New System.Drawing.Font("Times New Roman", 20.25F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        dtpSaleDate.Location = New Point(16, 469)
        dtpSaleDate.Size = New System.Drawing.Size(402, 39)
        dtpSaleDate.TabIndex = 9
        Controls.Add(dtpSaleDate)

        lblSaleTime = New Label()
        lblSaleTime.Font = New System.Drawing.Font("Times New Roman", 20.25F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        lblSaleTime.Location = New Point(429, 469)
        lblSaleTime.Text = "Sale Time"
        lblSaleTime.Size = New System.Drawing.Size(177, 39)
        lblSaleTime.TabIndex = 11
        Controls.Add(lblSaleTime)

        '  Label: Tendered
        lblTendered = New Label()
        lblTendered.AutoSize = True
        lblTendered.Font = New System.Drawing.Font("Georgia", 20.25F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        lblTendered.Location = New Point(1089, 449)
        lblTendered.TabIndex = 15
        lblTendered.Text = "Tendered:"
        Controls.Add(lblTendered)

        '  Text Box: Amount Tendered
        txtAmountTendered = New TextBox()
        txtAmountTendered.Font = New System.Drawing.Font("Times New Roman", 21.75F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        txtAmountTendered.Location = New Point(1278, 445)
        txtAmountTendered.Size = New System.Drawing.Size(130, 41)
        txtAmountTendered.TabIndex = 14
        txtAmountTendered.Text = "0.00"
        txtAmountTendered.TextAlign = HorizontalAlignment.Right
        Controls.Add(txtAmountTendered)

        '  Label: Item Number to Remove
        lblItemNumberToRemove = New Label()
        lblItemNumberToRemove.AutoSize = True
        lblItemNumberToRemove.Font = New System.Drawing.Font("Georgia", 20.25F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        lblItemNumberToRemove.Location = New Point(16, 416)
        lblItemNumberToRemove.TabIndex = 18
        lblItemNumberToRemove.Text = "Item # to Remove:"
        Controls.Add(lblItemNumberToRemove)

        '  Text Box: Item Number to Remove
        txtItemNumberRemove = New TextBox()
        txtItemNumberRemove.Font = New System.Drawing.Font("Times New Roman", 21.75F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        txtItemNumberRemove.Location = New Point(290, 412)
        txtItemNumberRemove.Size = New System.Drawing.Size(155, 41)
        txtItemNumberRemove.TabIndex = 19
        Controls.Add(txtItemNumberRemove)

        '  Button: Remove Item
        btnRemoveItem = New Button()
        btnRemoveItem.Font = New System.Drawing.Font("Times New Roman", 20.25F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        btnRemoveItem.Location = New Point(451, 408)
        btnRemoveItem.Size = New System.Drawing.Size(155, 46)
        btnRemoveItem.TabIndex = 20
        btnRemoveItem.Text = "Remove"
        Controls.Add(btnRemoveItem)

        '  Label: Order Total
        lblOrderTotal = New Label()
        lblOrderTotal.AutoSize = True
        lblOrderTotal.Font = New System.Drawing.Font("Georgia", 20.25F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        lblOrderTotal.Location = New Point(1089, 401)
        lblOrderTotal.TabIndex = 12
        lblOrderTotal.Text = "Order Total:"
        Controls.Add(lblOrderTotal)

        '  Text Box: Order Total
        txtOrderTotal = New TextBox()
        txtOrderTotal.Font = New System.Drawing.Font("Times New Roman", 21.75F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        txtOrderTotal.Location = New Point(1278, 396)
        txtOrderTotal.Size = New System.Drawing.Size(130, 41)
        txtOrderTotal.TabIndex = 13
        txtOrderTotal.Text = "0.00"
        txtOrderTotal.TextAlign = HorizontalAlignment.Right
        Controls.Add(txtOrderTotal)

        '  Label: Change
        lblChange = New Label()
        lblChange.AutoSize = True
        lblChange.Font = New System.Drawing.Font("Georgia", 20.25F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        lblChange.Location = New Point(1089, 496)
        lblChange.TabIndex = 16
        lblChange.Text = "Change:"
        Controls.Add(lblChange)

        '  Text Box: Change
        txtChange = New TextBox()
        txtChange.Font = New System.Drawing.Font("Times New Roman", 21.75F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        txtChange.Location = New Point(1278, 492)
        txtChange.Size = New System.Drawing.Size(129, 41)
        txtChange.TabIndex = 17
        txtChange.Text = "0.00"
        txtChange.TextAlign = HorizontalAlignment.Right
        Controls.Add(txtChange)

        '  Label: Employee Number
        lblEmployeeNumber = New Label()
        lblEmployeeNumber.AutoSize = True
        lblEmployeeNumber.Font = New System.Drawing.Font("Georgia", 20.25F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        lblEmployeeNumber.Location = New Point(10, 558)
        lblEmployeeNumber.TabIndex = 0
        lblEmployeeNumber.Text = "Employee #:"
        Controls.Add(lblEmployeeNumber)

        '  Text Box: Employee Number
        txtEmployeeNumber = New TextBox()
        txtEmployeeNumber.Font = New System.Drawing.Font("Times New Roman", 21.75F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        txtEmployeeNumber.Location = New Point(206, 554)
        txtEmployeeNumber.Size = New System.Drawing.Size(155, 41)
        txtEmployeeNumber.TabIndex = 1
        Controls.Add(txtEmployeeNumber)

        '  Text Box: Employee Name
        txtEmployeeName = New TextBox()
        txtEmployeeName.Font = New System.Drawing.Font("Times New Roman", 21.75F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        txtEmployeeName.Location = New Point(370, 554)
        txtEmployeeName.Size = New System.Drawing.Size(499, 41)
        txtEmployeeName.TabIndex = 7
        Controls.Add(txtEmployeeName)

        '  Button: Reset
        btnReset = New Button()
        btnReset.Font = New System.Drawing.Font("Times New Roman", 20.25F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        btnReset.Location = New Point(915, 551)
        btnReset.Size = New System.Drawing.Size(172, 46)
        btnReset.TabIndex = 10
        btnReset.Text = "Reset"
        Controls.Add(btnReset)

        '  Button: Submit
        btnSubmit = New Button()
        btnSubmit.Font = New System.Drawing.Font("Times New Roman", 20.25F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        btnSubmit.Location = New Point(1097, 551)
        btnSubmit.Size = New System.Drawing.Size(177, 46)
        btnSubmit.TabIndex = 4
        btnSubmit.Text = "Submit"
        Controls.Add(btnSubmit)

        '  Button: Close
        btnClose = New Button()
        btnClose.Font = New System.Drawing.Font("Times New Roman", 20.25F, System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, 0)
        btnClose.Location = New Point(1281, 551)
        btnClose.Size = New System.Drawing.Size(129, 46)
        btnClose.TabIndex = 21
        btnClose.Text = "Close"
        Controls.Add(btnClose)

        tmrDateTime = New Timer()
        tmrDateTime.Enabled = True

        strFilePath = "C:\FunDS\FunDS1.accdb ' "FunDS1.mdb"

        ClientSize = New System.Drawing.Size(1454, 615)
        MaximizeBox = False
        MinimizeBox = False
        StartPosition = FormStartPosition.CenterScreen
        Text = "FunDS - Shopping Session"
    End Sub

    Private Sub ResetForm()
        Dim iReceiptNumber As Integer = 100000

        Using odcStoreSales As OleDbConnection = New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFilePath) ' Provider=Microsoft.JET.OLEDB.4.0
            Dim cmdStoreSales As OleDbCommand = New OleDbCommand("SELECT ReceiptNumber " & _
                                                                 "FROM StoreSales;", _
                                                                 odcStoreSales)

            odcStoreSales.Open()

            Dim sdaStoreSales As OleDbDataAdapter = New OleDbDataAdapter(cmdStoreSales)
            Dim dsStoreSales As DataSet = New DataSet("StoreSalesSet")

            sdaStoreSales.Fill(dsStoreSales)

            For Each drStoreSale As DataRow In dsStoreSales.Tables(0).Rows
                iReceiptNumber = CInt(drStoreSale("ReceiptNumber"))
            Next
        End Using

        txtReceiptNumber.Text = CStr(iReceiptNumber + 1)
        txtItemNumberSelected.Text = ""
        lvwSelectedItems.Items.Clear()
        txtItemNumberRemove.Text = ""
        dtpSaleDate.Value = DateTime.Now
        lblSaleTime.Text = DateTime.Now.ToString()
        txtEmployeeNumber.Text = ""
        txtEmployeeName.Text = ""
        txtOrderTotal.Text = "0.00"
        txtAmountTendered.Text = "0.00"
        txtChange.Text = "0.00"
    End Sub

    Private Sub FormLoad(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load
        ResetForm()
    End Sub

    Private Sub btnResetClick(ByVal sender As Object, ByVal e As EventArgs) Handles btnReset.Click
        ResetForm()
    End Sub

    Private Sub tmrDateTimeTick(ByVal sender As Object, ByVal e As EventArgs) Handles tmrDateTime.Tick
        dtpSaleDate.Value = DateTime.Today
        lblSaleTime.Text = DateTime.Now.ToLongTimeString()
    End Sub

    Private Sub txtItemNumberSelectedKeyUp(ByVal sender As Object, ByVal e As keyEventArgs) Handles txtItemNumberSelected.KeyUp
        Dim dblTotal As Double = 0.0

        If e.KeyCode = Keys.Enter Then
            If (String.IsNullOrEmpty(txtItemNumberSelected.Text)) Then
                MsgBox("You must enter an item number.", vbOkOnly Or vbInformation, "FunDS - Fun Department Store")
                Exit Sub
            Else
                Using odcStoreItems As OleDbConnection = New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFilePath)
                    Dim cmdStoreItems As OleDbCommand = New OleDbCommand("SELECT ItemNumber, ItemName, ItemSize, UnitPrice, DiscountRate " & _
                                                                         "FROM StoreItems " & _
                                                                         "WHERE ItemNumber = '" & txtItemNumberSelected.Text & "';", _
                                                                         odcStoreItems)

                    odcStoreItems.Open()

                    Dim sdaStoreItems As OleDbDataAdapter = New OleDbDataAdapter(cmdStoreItems)
                    Dim dsStoreItems As DataSet = New DataSet("StoreItemSet")

                    sdaStoreItems.Fill(dsStoreItems)

                    For Each drStoreItem As DataRow In dsStoreItems.Tables(0).Rows
                        Dim lviStoreItem As ListViewItem = New ListViewItem(CStr(drStoreItem("ItemNumber")))

                        lviStoreItem.SubItems.Add(CStr(drStoreItem("ItemName")))

                        If IsDBNull(drStoreItem("ItemSize")) Then
                            lviStoreItem.SubItems.Add("")
                        Else
                            lviStoreItem.SubItems.Add(CStr(drStoreItem("ItemSize")))
                        End If

                        lviStoreItem.SubItems.Add(FormatNumber(CStr(drStoreItem("UnitPrice"))))

                        If IsDBNull(drStoreItem("DiscountRate")) Then
                            lviStoreItem.SubItems.Add("0") ' Discount Rate
                            lviStoreItem.SubItems.Add("0.00") ' Discount Amount
                            lviStoreItem.SubItems.Add(FormatNumber(CStr(drStoreItem("UnitPrice")))) ' Sale Price
                        Else
                            Dim unitPrice = CDbl(CStr(drStoreItem("UnitPrice")))

                            Dim discountRate As Double = CDbl(drStoreItem("DiscountRate"))
                            Dim discountAmount = unitPrice * discountRate
                            Dim salePrice = unitPrice - discountAmount

                            lviStoreItem.SubItems.Add(FormatNumber(CStr(discountRate * 100), 0) & "%") ' Discount Rate
                            lviStoreItem.SubItems.Add(FormatNumber(CStr(discountAmount))) ' Discount Amount
                            lviStoreItem.SubItems.Add(FormatNumber(CStr(salePrice))) ' Sale Price
                        End If

                        lvwSelectedItems.Items.Add(lviStoreItem)
                    Next

                    txtItemNumberSelected.Text = ""

                    If lvwSelectedItems.Items.Count > 0 Then
                        For Each lviStoreItem As ListViewItem In lvwSelectedItems.Items
                            dblTotal = dblTotal + CDbl(lviStoreItem.SubItems(6).Text)
                        Next

                        txtOrderTotal.Text = FormatNumber(dblTotal)
                    End If
                End Using
            End If
        End If
    End Sub

    Private Sub txtEmployeeNumberLeave(ByVal sender As Object, ByVal e As EventArgs) Handles txtEmployeeNumber.Leave
        If IsDBNull(txtEmployeeNumber.Text) Or IsNothing(txtEmployeeNumber.Text) Then
            Exit Sub
        Else
            Using odcEmployees As OleDbConnection = New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFilePath)
                Dim cmdEmployees As OleDbCommand = New OleDbCommand("SELECT FirstName, LastName " & _
                                                                     "FROM Employees " & _
                                                                     "WHERE EmployeeNumber = '" & txtEmployeeNumber.Text & "';", _
                                                                     odcEmployees)

                odcEmployees.Open()

                Dim sdaEmployees As OleDbDataAdapter = New OleDbDataAdapter(cmdEmployees)
                Dim dsEmployees As DataSet = New DataSet("EmployeesSet")

                sdaEmployees.Fill(dsEmployees)

                For Each drEmployee As DataRow In dsEmployees.Tables(0).Rows
                    txtEmployeeName.Text = CStr(drEmployee("LastName")) & ", " & CStr(drEmployee("FirstName"))
                Next
            End Using
        End If
    End Sub

    Private Sub txtAmountTenderedKeyUp(ByVal sender As Object, ByVal e As KeyEventArgs) Handles txtAmountTendered.KeyUp
        Dim orderTotal As Double = 0.0
        Dim amountTendered As Double = 0.0
        Dim change As Double = 0.0

        If (e.KeyCode = Keys.Tab) Or (e.KeyCode = Keys.Enter) Then
            If IsDBNull(txtOrderTotal.Text) Then
                Exit Sub
            End If
        ElseIf IsDBNull(txtAmountTendered.Text) Then
            Exit Sub
        Else
            orderTotal = CDbl(txtOrderTotal.Text)
            amountTendered = CDbl(txtAmountTendered.Text)
            change = amountTendered - orderTotal

            txtChange.Text = FormatNumber(change)
        End If
    End Sub

    Private Sub txtAmountTenderedLeave(ByVal sender As Object, ByVal e As EventArgs) Handles txtAmountTendered.Leave
        Dim orderTotal As Double = 0.0
        Dim amountTendered As Double = 0.0
        Dim change As Double = 0.0

        If IsDBNull(txtOrderTotal.Text) Then
            Exit Sub
        ElseIf IsDBNull(txtAmountTendered.Text) Then
            Exit Sub
        Else
            orderTotal = CDbl(txtOrderTotal.Text)
            amountTendered = CDbl(txtAmountTendered.Text)
            change = amountTendered - orderTotal

            txtChange.Text = FormatNumber(change)
        End If
    End Sub

    Private Sub btnRemoveItemClick(ByVal sender As Object, ByVal e As EventArgs) Handles btnRemoveItem.Click
        Dim dblTotal As Double = 0.0
        Dim itemFound As Boolean = False

        If lvwSelectedItems.Items.Count = 0 Then
            MsgBox("The list view is empty.", vbOkOnly Or vbInformation, "FunDS - Fun Department Store")
            Exit Sub
        ElseIf IsDBNull(txtItemNumberRemove.Text) Then
            MsgBox("You must enter an item number and that exists in the list view.",
                   vbOkOnly Or vbInformation, "FunDS - Fun Department Store")
            Exit Sub
        Else
            For Each lviStoreItem As ListViewItem In lvwSelectedItems.Items
                If lviStoreItem.SubItems(0).Text = txtItemNumberRemove.Text Then
                    itemFound = True
                    lvwSelectedItems.Items.Remove(lviStoreItem)
                End If
            Next

            If itemFound = False Then
                MsgBox("That item number is not in the list view.",
                       vbOkOnly Or vbInformation, "FunDS - Fun Department Store")
                Exit Sub
            End If

            If lvwSelectedItems.Items.Count > 0 Then
                For Each lviStoreItem As ListViewItem In lvwSelectedItems.Items
                    dblTotal = dblTotal + CDbl(lviStoreItem.SubItems(6).Text)
                Next

                txtOrderTotal.Text = FormatNumber(dblTotal)
                txtAmountTendered.Text = "0.00"
                txtChange.Text = "0.00"
            Else
                txtOrderTotal.Text = "0.00"
                txtAmountTendered.Text = "0.00"
                txtChange.Text = "0.00"
            End If

            txtItemNumberRemove.Text = ""
        End If
    End Sub

    Private Sub btnSubmitClick(ByVal sender As Object, ByVal e As EventArgs) Handles btnSubmit.Click
        Dim strSoldItem As String
        Dim strStoreSale As String

        If lvwSelectedItems.Items.Count = 0 Then
            MsgBox("There is no customer order to save.",
                   vbOkOnly Or vbInformation, "FunDS - Fun Department Store")
            Exit Sub
        Else
            strStoreSale = "INSERT INTO StoreSales(ReceiptNumber, EmployeeNumber, SaleDate, SaleTime, OrderTotal, AmountTendered, Change)" & 
                           "VALUES(" & CInt(txtReceiptNumber.Text) & ", '" + txtEmployeeNumber.Text & "', #" & 
                           dtpSaleDate.Value.ToShortDateString() & "#, #" & lblSaleTime.Text.ToString() & "#, " & 
                           CDbl(txtOrderTotal.Text) & ", " & CDbl(txtAmountTendered.Text) & ", " & CDbl(txtChange.Text) & ");"

            ' Create a customer order using the information on the form except the items in the list view.
            Using odcStoreSales As OleDbConnection = New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFilePath)
                Dim cmdStoreSales As OleDbCommand = New OleDbCommand(strStoreSale, odcStoreSales)
                odcStoreSales.Open()
                cmdStoreSales.ExecuteNonQuery()
            End Using

            For Each lviStoreItem As ListViewItem In lvwSelectedItems.Items
                If IsDBNull(lviStoreItem.SubItems(2).Text) Then
                    strSoldItem = "INSERT INTO SoldItems(ReceiptNumber, ItemNumber, ItemName, UnitPrice, DiscountRate, DiscountAmount, SalePrice) VALUES(" & _
                                  CInt(txtReceiptNumber.Text) & ", " & lviStoreItem.SubItems(0).Text & ", '" & lviStoreItem.SubItems(1).Text & "', " & _
                                  CDbl(lviStoreItem.SubItems(3).Text) & ", " & (CDbl(Replace(lviStoreItem.SubItems(4).Text, "%", "")) / 100) & ", " & CDbl(lviStoreItem.SubItems(5).Text) & _
                                  ", " & CDbl(lviStoreItem.SubItems(6).Text) & ");"
                Else
                    strSoldItem = "INSERT INTO SoldItems(ReceiptNumber, ItemNumber, ItemName, ItemSize, UnitPrice, DiscountRate, DiscountAmount, SalePrice) VALUES(" & _
                                  CInt(txtReceiptNumber.Text) & ", '" & lviStoreItem.SubItems(0).Text & "', '" & lviStoreItem.SubItems(1).Text & "', '" & _
                                  lviStoreItem.SubItems(2).Text & "', " & CDbl(lviStoreItem.SubItems(3).Text) & ", " & (CDbl(Replace(lviStoreItem.SubItems(4).Text, "%", "")) / 100) & _
                                  ", " & CDbl(lviStoreItem.SubItems(5).Text) & ", " & CDbl(lviStoreItem.SubItems(6).Text) & ");"
                End If

                ' Add the items of the list view in the SoldItems table
                Using odcStoreSales As OleDbConnection = New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFilePath)
                    Dim cmdSoldItems As OleDbCommand = New OleDbCommand(strSoldItem, odcStoreSales)
                    odcStoreSales.Open()
                    cmdSoldItems.ExecuteNonQuery()
                End Using
            Next

            ' Remove the items of the list view from the StoreItems table
            For Each lviStoreItem As ListViewItem In lvwSelectedItems.Items
                Using odcStoreSales As OleDbConnection = New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFilePath)
                    Dim cmdStoreItems As OleDbCommand = New OleDbCommand("DELETE FROM StoreItems " & _
                                                                         "WHERE ItemNumber = '" & lviStoreItem.SubItems(0).Text & "';", odcStoreSales)
                    odcStoreSales.Open()
                    cmdStoreItems.ExecuteNonQuery()
                End Using
            Next

            MsgBox("The customer's order has been saved.",
                   vbOkOnly Or vbInformation, "FunDS - Fun Department Store")
            ResetForm()
        End If
    End Sub

    Private Sub btnCloseClick(ByVal sender As Object, ByVal e As EventArgs) Handles btnClose.Click
        Close()
    End Sub

    <STAThread()>
    Public Shared Sub Main()
        Application.Run(New ShoppingSession())
    End Sub

End Class

Close the text editor (or Notepad)
When asked whether you want to save, click Save
Select the FunDS folder you had created and display it in the top combo box
Change the Save As Type (or files of type) combo box to All Files
Set the file name to ShoppingSession.vb
Click Save
Display the Command Prompt (Start -> (All) Programs -> Accessories -> Command Prompt)
Type CD\ and press Enter to get to the root
Type C: and press Enter to select the C: drive
Type CD FunDS and press Enter to select the folder that contains the database
Type vbc /t:winexe ShoppingSession.vb and press Enter to build the project
If you receive an error that vbc is not a valid program type:
```
C:\Windows\Microsoft.NET\Framework\v4.0.30319\vbc /t:winexe ShoppingSession.vb
```
and press Enter
To close the Command Prompt, type exit and press Enter
Return to Microsoft Access where the FunDS1 database is opened
On the Ribbon, click Create and, in the Forms section, click Form Design
Using the Properties window, set the following characteristics:
Caption: Fun Department Store - Shopping Session Review
Auto Center: Yes
Navigation Buttons: No
In the Design section of the Ribbon, click Subform/Subreport and click the form
On the first page of the wizard, click Use An Existing Form
In the list box, click sfSoldItems
Click Next
Click Finish
In the Properties window, click Link Master Fields and type ReceiptNumber
Click Link Child Fields and type ReceiptNumber
Right-click the form and click Form Header/Footer
Save the form as ShoppingSessionReview
Design it as follows:
Save the form
Right-click the Find button and click Buils Event...
In the Choose Builder dialog b ox, click Code Builder and click OK

Implement the event as follows:

Private Sub cmdFind_Click()
    If IsNull(ReceiptNumber) Then
        MsgBox "You must enter a receipt number before viewing related records.", _
               vbInformation Or vbOKOnly, "Ceil Inn"
    Else
        If Not IsNull(DLookup("ReceiptNumber", "StoreSales", "ReceiptNumber = " & ReceiptNumber)) Then
            txtEmployeeNumber = DLookup("EmployeeNumber", "StoreSales", "ReceiptNumber = " & ReceiptNumber)
            txtSaleDate = FormatDateTime(DLookup("SaleDate", "StoreSales", "ReceiptNumber = " & ReceiptNumber), vbLongDate)
            txtSaleTime = DLookup("SaleTime", "StoreSales", "ReceiptNumber = " & ReceiptNumber)
            txtOrderTotal = DLookup("OrderTotal", "StoreSales", "ReceiptNumber = " & ReceiptNumber)
            txtAmountTendered = DLookup("AmountTendered", "StoreSales", "ReceiptNumber = " & ReceiptNumber)
            txtChange = DLookup("Change", "StoreSales", "ReceiptNumber = " & ReceiptNumber)
            
            txtEmployeeName = DLookup("LastName", "Employees", "EmployeeNumber = '" & txtEmployeeNumber & "'") & ", " & DLookup("FirstName", "Employees", "EmployeeNumber = '" & txtEmployeeNumber & "'")
        End If
    End If
End Sub

In Object combo box, select cmdNewShoppingSession

Implement its OnClick event as follows:

Private Sub cmdNewShoppingSession_Click()
    Shell "C:\FunDS\ShoppingSession.exe", vbNormalFocus
End Sub

In Object combo box, select cmdClose

Implement its OnClick event as follows:

Private Sub cmdClose_Click()
    DoCmd.Close
End Sub

Save and close the form

Application Testing

If you want to test the application, use the following values.

Employee #	First Name	Last Name	Title
941148	Catherine	Watts	Owner - General Manager
248574	Jeannette	Newsome	Cashier
973958	Isaac	Saunders	Head Cashier
266830	Robert	Gwynne	Cashier
720842	Nicole	Malone	Cashier
317462	Laura	Amiens	Cashier

Item #	Manufacturer	Category	Sub-Category	Item Name	Item Size	Unit Price	Discount Rate
177314	Ralph Lauren	Girls	Shirts	Girls 2-6X Short-Sleeved Mesh Polo Shirt	3T	34.95
683079	Anne Klein	Women	Skirts	Pencil Skirt	2	54
221573	Nautica	Baby Girls		Baby Girls 12-24 Months Lace Two-Piece Set	12M	40
683276	Ralph Lauren	Women	Dresses	Structured Scoopneck Ponte Dress	0	195	60
327367	Polo Ralph Lauren	Men	Pants	Classic Straight-Leg Jeans	30W - 29L	84.85	15
856888	Guess	Girls	Dresses	Girls 2-6X Denim Print Ruffled Dress	2T	34.95
510040	Cole Haan	Women	Handbags	Victoria Zip-Top Tote Bag		298
195101	Lauren by Ralph Lauren	Men	Pants	Mid-Weight Flat-Front Wool Trouser Pants	36W 32L	65	25
239530	Kenneth Cole	Women	Dresses	Three-Quarter Sleeved Dress	M	164.5	50
367872	Lauren by Ralph Lauren	Women	Accessories	Printed Silk Scarf		45
239148	Lauren by Ralph Lauren	Men	Pants	Mid-Weight Flat-Front Wool Trouser Pants	36W 29L	65
559110	Guess	Girls	Dresses	Girls 2-6X Denim Print Ruffled Dress	3T	34.95
830487	AK Anne Klein	Women	Skirts	Seamless Textured Pencil Skirt	S	65.95
848438	Ralph Lauren	Boys	Sweaters	Boys 2-7 Long-Sleeved Cable Crewneck T-Shirt	4	55
343511	Calvin Klein	Men	Pants	Straight Leg Jean in Black Wash	32/30	45
948596	Tommy Hilfiger	Men	Shirts	Texture Oxford Slim Fit Long Sleeve Dress Shirt	17 - 34/35	47.75

Employee #	Item #	Tendered
941148	848438
	239530	200

Employee #	Item #	Tendered
317462	683276
	327367
	856888	200

Employee #	Item #	Tendered
317462	239148	65