Orders Project

This project was written in response to a post on the VBExplorer Data Access Forum asking about a simple database for creating a store allowing users to log in to the store and create an order.(Probably a student assignment). It uses ADO and ADOX code only so is NOT Suitable for use with Access 97 format databases.(The .Seek method does not function in ADO with 97). It demonstrates the following features:

- Public database variables declared in a code module for use in the whole project.
- Use of Sub Main instead of a start-up form whent the project is started
- Database creation using ADOX code:
- - AllowZero Length fields
- - Autonumber fields
- - Primary Key Index
- Login form with use of password characters in textbox, Adding new users.
- Use of a Flexgrid with floating editing textbox to alter the unbound grid cell contents and write the changes directly to the database.

Download project (VB6 SP5, MDAC 2.7, Jet4 SP3) here If you need links to update VB6 to Service Pack 5 or data access drivers see Homepage

On startup, the following window is displayed:

This is NOT the startup form, the project starts from a Sub created in a code module and given the title "Main"

Private Sub Main()
    'check if database already exists
    If Dir$(App.Path & "\Orders.mdb") = "" Then
        CreateDatabase
    Else
        OpenDatabase
    End If
    'show login form
    frmLogin.Show
End Sub

The above code checks if the database has already been created. If so then the following code is used:

Public Sub OpenDatabase()
    'set up connection
    Set cnn = New ADODB.Connection
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Orders.mdb"
    'open table-type recordsets
    cnn.CursorLocation = adUseServer
    rsItems.Open "Items", cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
    rsItems.Index = "ID"
    rsOrders.Open "Orders", cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
    rsOrders.Index = "ID"
    rsCustomers.Open "Customers", cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
    rsCustomers.Index = "UserName"
End Sub

If the database does not exist then ADOX code is used to create it:

Public Sub CreateDatabase()
    Dim tbl As ADOX.Table
    Dim col As ADOX.Column
    Dim iX As ADOX.Index
    Dim lID As Long

    'create database
    cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Orders.mdb"

    'create Items table
    Set tbl = New ADOX.Table
    tbl.Name = "Items"
    'append table
    cat.Tables.Append tbl

    ' Create fields and append them to the
    ' Columns collection of the new Table object.
    With tbl
        Set col = New ADOX.Column
        With col
            .Name = "ID"
            .Type = adInteger
            'refer to parent catalog to allow autonumber to be set up
            Set .ParentCatalog = cat
            'Make it Autonumber
            .Properties("AutoIncrement") = True
            .SortOrder = adSortAscending
        End With
        .Columns.Append col
        Set col = Nothing

        'create text field called "Description"
        Set col = New ADOX.Column
        With col
            .Name = "Description"
            .DefinedSize = 150
            .Type = adVarWChar
            .Attributes = adColNullable
            .SortOrder = adSortAscending
        End With
        .Columns.Append col
        Set col = Nothing
        'allow zero length field
        .Columns("Description").Properties("Jet OLEDB:Allow Zero Length") = True

        'create text field called "Price"
        Set col = New ADOX.Column
        With col
            .Name = "Price"
            .Type = adCurrency
            .Attributes = adColNullable
            .SortOrder = adSortAscending
        End With
        .Columns.Append col
        Set col = Nothing

        'create Primary Index
        Set iX = New ADOX.Index
        With iX
          .PrimaryKey = True
          .Unique = True
          .IndexNulls = adIndexNullsDisallow
          .Name = "ID"
          'Define Index field(s)
          .Columns.Append "ID"
        End With
        'append index
        .Indexes.Append iX
    End With
    Set tbl = Nothing

    'create Customers table
    Set tbl = New ADOX.Table
    tbl.Name = "Customers"
    'append table
    cat.Tables.Append tbl

    ' Create fields and append them to the
    ' Columns collection of the new Table object.
    With tbl
        Set col = New ADOX.Column
        With col
            .Name = "ID"
            .Type = adInteger
            'refer to parent catalog to allow autonumber to be set up
            Set .ParentCatalog = cat
            'Make it Autonumber
            .Properties("AutoIncrement") = True
            .SortOrder = adSortAscending
        End With
        .Columns.Append col
        Set col = Nothing

        'create text field called "Username"
        Set col = New ADOX.Column
        With col
            .Name = "UserName"
            .DefinedSize = 50
            .Type = adVarWChar
            .SortOrder = adSortAscending
        End With
        .Columns.Append col
        Set col = Nothing

        'create text field called "Password"
        Set col = New ADOX.Column
        With col
            .Name = "Password"
            .DefinedSize = 50
            .Type = adVarWChar
            .SortOrder = adSortAscending
        End With
        .Columns.Append col
        Set col = Nothing

        'create text field called "Surname"
        Set col = New ADOX.Column
        With col
            .Name = "Surname"
            .DefinedSize = 50
            .Type = adVarWChar
            .Attributes = adColNullable
            .SortOrder = adSortAscending
        End With
        .Columns.Append col
        Set col = Nothing
        'allow zero length field
        .Columns("Surname").Properties("Jet OLEDB:Allow Zero Length") = True

        'create text field called "FirstName"
        Set col = New ADOX.Column
        With col
            .Name = "FirstName"
            .DefinedSize = 50
            .Type = adVarWChar
            .Attributes = adColNullable
            .SortOrder = adSortAscending
        End With
        .Columns.Append col
        Set col = Nothing
        'allow zero length field
        .Columns("FirstName").Properties("Jet OLEDB:Allow Zero Length") = True

        'create text field called "Address"
        Set col = New ADOX.Column
        With col
            .Name = "Address"
            .DefinedSize = 150
            .Type = adVarWChar
            .Attributes = adColNullable
            .SortOrder = adSortAscending
        End With
        .Columns.Append col
        Set col = Nothing
        'allow zero length field
        .Columns("Address").Properties("Jet OLEDB:Allow Zero Length") = True

        'create Primary Index
        Set iX = New ADOX.Index
        With iX
          .PrimaryKey = True
          .Unique = True
          .IndexNulls = adIndexNullsDisallow
          .Name = "ID"
          'Define Index field(s)
          .Columns.Append "ID"
        End With
        'append index
        .Indexes.Append iX

        'create UserName Index
        Set iX = New ADOX.Index
        With iX
          .PrimaryKey = False
          .Unique = True
          .IndexNulls = adIndexNullsDisallow
          .Name = "UserName"
          'Define Index field(s)
          .Columns.Append "UserName"
        End With
        'append index
        .Indexes.Append iX
    End With
    Set tbl = Nothing

    'create table
    Set tbl = New ADOX.Table
    tbl.Name = "Orders"
    'append table
    cat.Tables.Append tbl

    ' Create fields and append them to the
    ' Columns collection of the new Table object.
    With tbl
        Set col = New ADOX.Column
        With col
            .Name = "ID"
            .Type = adInteger
            'refer to parent catalog to allow autonumber to be set up
            Set .ParentCatalog = cat
            'Make it Autonumber
            .Properties("AutoIncrement") = True
            .SortOrder = adSortAscending
        End With
        .Columns.Append col
        Set col = Nothing

        'create text field called "CustomerID"
        Set col = New ADOX.Column
        With col
            .Name = "CustomerID"
            .Type = adInteger
            .Attributes = adColNullable
            .SortOrder = adSortAscending
        End With
        .Columns.Append col
        Set col = Nothing

        'create memo field called "OrderList"
        Set col = New ADOX.Column
        With col
            .Name = "OrderList"
            .Type = adLongVarWChar
            .Attributes = adColNullable
            .SortOrder = adSortAscending
        End With
        .Columns.Append col
        Set col = Nothing
        'allow zero length field
        .Columns("OrderList").Properties("Jet OLEDB:Allow Zero Length") = True

        'create Primary Index
        Set iX = New ADOX.Index
        With iX
          .PrimaryKey = True
          .Unique = True
          .IndexNulls = adIndexNullsDisallow
          .Name = "ID"
          'Define Index field(s)
          .Columns.Append "ID"
        End With
        'append index
        .Indexes.Append iX
    End With
    Set tbl = Nothing
    Set cat = Nothing



    'now add some data
    'open new table
    Set cnn = New ADODB.Connection
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Orders.mdb"
    rsItems.Open "Items", cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
    Set cat = New ADOX.Catalog
    cat.ActiveConnection = cnn
    'now add some data
    rsItems.AddNew
    'shorthand method
    rsItems!Description = "Apple"
    'longhand method to do same thing
    rsItems.Fields("Price").Value = 1.25
    rsItems.Update

    rsItems.AddNew
    rsItems!Description = "Orange"
    rsItems!Price = 0.25
    rsItems.Update

    rsItems.AddNew
    rsItems!Description = "Pear"
    rsItems!Price = 0.75
    rsItems.Update

    rsItems.AddNew
    rsItems!Description = "Banana"
    rsItems!Price = 1.89
    rsItems.Update

    rsItems.AddNew
    rsItems!Description = "Avocado"
    rsItems!Price = 2.35
    rsItems.Update


    rsItems.Close
    cnn.Close
    Set cnn = Nothing
    'now re-open database and all three tables
    OpenDatabase
End Sub

Login Form	Main Form
Add User Form	Add / Edit Stock Form
Homepage

Page last modified 06/02/2003