by Tom Brennfleck - GUI Computing

I recently had the need to create a table so a customer's database could be updated with the new database definition. Without having to supply the database, I wondered what the most efficient method would be.

I found myself remembering back to the first table I created in code. Lots of code along the following lines (see AddTable), with all sorts of arrays holding field and index information. You can use the following to create a table, but check AddTable2 first and you will see how much easier it is to maintain and probably runs faster too.

Add Table

  Sub AddTable ()
  Const DB_TEXT = 10                              ' Set field type constant.

    Dim MyDb As Database
    Dim tbl As New TableDef
    Dim fld As Field
    Dim ind As Index
    Dim i As Integer
    Dim x As String
    Dim cFields As String
    
    On Error GoTo ATErr

    Set MyDb = OpenDatabase("E:\VB\BIBLIO1.MDB")  ' Open a database.       

    tbl.Name = "Test"

    ' search to see if table exists
    For i = 0 To MyDb.TableDefs.Count - 1
      If UCase(MyDb.TableDefs(i).Name) = UCase(tbl.Name) Then
        If MsgBox(tbl.Name + " already exists, delete it?", 4) = 6 Then
          MyDb.TableDefs.Delete MyDb.TableDefs(tbl.Name)
        Else
          Exit Sub
        End If
        Exit For
      End If
    Next

    ' add the first field
    cFields = "Field 1"
    If cFields = "" Then
      Beep
      MsgBox "No Fields Defined!", 48
      Exit Sub
    End If
    Set fld = New Field
    fld.Name = cFields
    fld.Type = DB_TEXT                            ' text type
    'fld.Attributes =
    fld.Size = 15
    tbl.Fields.Append fld
    
    MyDb.TableDefs.Append tbl

    ' add the rest of the fields
    For i = 2 To 5
      Set fld = New Field
      fld.Name = "Field " & i
      fld.Type = DB_TEXT
      'fld.Attributes =
      fld.Size = 15
      MyDb.TableDefs(tbl.Name).Fields.Append fld
    Next

    ' add the indexes
    For i = 1 To 2
      Set ind = New Index
      ind.Name = "Index" & i
      ind.Fields = "Field " & i
      If i = 1 Then
        ind.Unique = True
      Else
        ind.Unique = False
      End If
      If i = 1 Then
        ind.Primary = True
      Else
        ind.Primary = False
      End If
      MyDb.TableDefs(tbl.Name).Indexes.Append ind
    Next

    GoTo ATEnd

  ATErr:

    ' error handler
    Resume ATEnd

  ATEnd:

    ' exit handler
    Unload Me

End Sub

Add Table 2

  Sub AddTable2 ()
    Dim MyDb As Database
    Dim SQL As String
    Dim i As Integer
    Dim tbl As New TableDef

    On Error GoTo AT2Err

    Set MyDb = OpenDatabase("E:\VB\BIBLIO1.MDB")  ' Open a database.

    ' search to see if table exists
    tbl.Name = "tblTest2"
    For i = 0 To MyDb.TableDefs.Count - 1
      If UCase(MyDb.TableDefs(i).Name) = UCase(tbl.Name) Then
        If MsgBox(tbl.Name + " already exists, delete it?", 4) = 6 Then
          MyDb.TableDefs.Delete MyDb.TableDefs(tbl.Name)
        Else
          Exit Sub
        End If
        Exit For
      End If
    Next
     
    SQL = "CREATE TABLE [tblTest2]"
    SQL = SQL & " ([Field 1] TEXT (50),"
    SQL = SQL & " [Field 2] DateTime ,"
    SQL = SQL & " [Field 3] SHORT ,"
    SQL = SQL & " [Field 4] TEXT (50),"
    SQL = SQL & " [Field 5] TEXT (50),"
    SQL = SQL & " [Field 6] TEXT (50),"
    SQL = SQL & " Comment Memo"
    SQL = SQL & " );"
    MyDb.Execute SQL
     
    SQL = "CREATE UNIQUE INDEX Index1"
    SQL = SQL & " ON tblTest2 ([Field 1])"
    SQL = SQL & "WITH PRIMARY;"
    MyDb.Execute SQL

    SQL = "CREATE INDEX Index2"
    SQL = SQL & " ON tblTest2 ([Field 2]);"
    MyDb.Execute SQL

    MyDb.Close

    GoTo AT2End

  AT2Err:

    ' error handler
    Resume AT2End

  AT2End:

    ' exit handler
    Unload Me

End Sub

[HOME] [TABLE OF CONTENTS] [SEARCH]