VBA/Excel/Access/Word/Access/Table Create

Adding a Single-Field Index to an Existing Table with SQL command

   <source lang="vb">

Sub SingleField_Index2()

   Dim conn As ADODB.Connection 
   Dim strTable As String 
   On Error GoTo ErrorHandler 
   Set conn = CurrentProject.Connection 
       strTable = "myTable" 
   conn.Execute "CREATE INDEX idxCity ON " & strTable & "(SCity) ;" 

ExitHere:

   conn.Close 
   Set conn = Nothing 
   Exit Sub 

ErrorHandler:

   MsgBox Err.Number & ":" & Err.Description 
   Resume ExitHere 

End Sub

</source>
   
  

Create a table with validation rule

   <source lang="vb">

Sub exaCreateTable()

   Dim db As Database
   Dim tblNew As TableDef
   Dim fld As Field
   
   Set db = CurrentDb
   
   Set tblNew = db.CreateTableDef("NewTable")
   Set fld = tblNew.CreateField("NewField", dbText, 100)
   
   fld.AllowZeroLength = True
   fld.DefaultValue = "Unknown"
   fld.Required = True
   fld.ValidationRule = "Instr$(Like "A*" or Like "Unknown""
   fld.ValidationText = "Known value must begin with A"
   tblNew.Fields.Append fld
   db.TableDefs.Append tblNew

End Sub

</source>
   
  

Creating an Index Based on Two Fields with SQL command

   <source lang="vb">

Sub MultiField_Index()

   Dim conn As ADODB.Connection 
   Dim strTable As String 
   On Error GoTo ErrorHandler 
   Set conn = CurrentProject.Connection 
   strTable = "myTable" 
   conn.Execute "CREATE TABLE " & strTable _ 
       & "(SId INTEGER, " _ 
       & "SName CHAR (30), " _ 
       & "SCity CHAR (19), " _ 
       & "CONSTRAINT idxSupplierNameCity UNIQUE " _ 
       & "(SName, SCity));" 
   Application.RefreshDatabaseWindow 

ExitHere:

       conn.Close 
       Set conn = Nothing 
       Exit Sub 

ErrorHandler:

       Debug.Print Err.Number & ":" & Err.Description 
       Resume ExitHere 

End Sub

</source>
   
  

Creating a Table (ADOX data types vs. Microsoft Access data types)

   <source lang="vb">

ADOX Data Type Corresponding Data Type in Access adBoolean Yes/No adUnsignedTinyInt Number (FieldSize = Byte) adSmalIInt Number (FieldSize = Integer) adSingle Number (FieldSize = Single) adDouble Number (FieldSize = Double) adDecimal Number (FieldSize = Decimal) adInteger Number (FieldSize = LongInteger) AutoNumber adCurrency Currency adVarWChar Text adDate Date/Time adLongVarBinary OLE Object dbMemo Memo adLongVarWChar Hyperlink " make sure to set up a reference to " the Microsoft ADO Ext. 2.5 for DDL and Security " Object Library Sub Create_Table()

  Dim cat As ADOX.Catalog
  Dim myTable As ADOX.Table
  On Error GoTo ErrorHandler
  Set cat = New Catalog
  cat.ActiveConnection = CurrentProject.Connection
  Set myTable = New Table
  With myTable
     .Name = "vbexTable"
     With .Columns
        .Append "Id", adVarWChar, 10
        .Append "Description", adVarWChar, 255
        .Append "Type", adInteger
     End With
  End With
  cat.Tables.Append myTable
  Set cat = Nothing
  MsgBox "The new table "vbexTable" was created."
  Exit Sub

ErrorHandler:

  If Err.Number = -2147217857 Then
     cat.Tables.Delete "vbexTable"
     Resume
  End If
  MsgBox Err.Number & ": " & Err.Description

End Sub

</source>
   
  

Creating a Table in a New Database with AUTOINCREMENT column

   <source lang="vb">

Sub CreateTableInNewDb()

   Dim cat As ADOX.Catalog
   Dim conn As ADODB.Connection
   Dim strDb As String
   Dim strTable As String
   Dim strConnect As String
   
   On Error GoTo ErrorHandler
   
   Set cat = New ADOX.Catalog
   strDb = CurrentProject.Path & "\mydb.mdb"
   strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDb
   
   cat.Create strConnect
   
   Set conn = cat.ActiveConnection
   
   conn.Execute "CREATE TABLE myTable(SchoolId AUTOINCREMENT(100, 5)," & _
       "SchoolName CHAR,City Char (25), District Char (35),YearEstablished Date);"

ExitHere:

   Set cat = Nothing
   Set conn = Nothing
   Exit Sub

ErrorHandler:

   If Err.Number = -2147217897 Then
       Kill strDb
       Resume 0
   Else
       Debug.Print Err.Number & ": " & Err.Description
       GoTo ExitHere
   End If

End Sub

</source>
   
  

Creating a Table in the Current Database with SQL statement

   <source lang="vb">

Sub CreateTable()

   Dim conn As ADODB.Connection
   Dim strTable As String
   On Error GoTo ErrorHandler
   Set conn = CurrentProject.Connection
   strTable = "Employees"
   conn.Execute "CREATE TABLE " & strTable & _
      "(Id AUTOINCREMENT(100, 5)," & _
      "lName CHAR," & _
      "City Char (25), District Char (35)," & _
      "YearEstablished Date);"
   Application.RefreshDatabaseWindow

ExitHere:

   conn.Close
   Set conn = Nothing
   Exit Sub

ErrorHandler:

   MsgBox Err.Number & ":" & Err.Description
   Resume ExitHere

End Sub

</source>
   
  

Creating a Table with a Single-Field Index with SQL command

   <source lang="vb">

Sub SingleField_Index()

   Dim conn As ADODB.Connection
   Dim strTable As String
   On Error GoTo ErrorHandler
   Set conn = CurrentProject.Connection
   strTable = "myTable"
   conn.Execute "CREATE TABLE " & strTable _
       & "(Id INTEGER, " _
       & "SName CHAR (30), " _
       & "CONSTRAINT idxSupplierName UNIQUE " _
       & "(SName));"
   Application.RefreshDatabaseWindow

ExitHere:

       conn.Close
       Set conn = Nothing
       Exit Sub

ErrorHandler:

       Debug.Print Err.Number & ":" & Err.Description
       Resume ExitHere

End Sub

</source>
   
  

Creating Check Constraints:add business rules for a table

   <source lang="vb">

Sub CreateCheckConstraint()

   Dim cmd As ADODB.rumand
   Set cmd = New ADODB.rumand
   cmd.ActiveConnection = CurrentProject.Connection
   cmd.rumandText = "CREATE TABLE Customers1 " & _
       "(CustomerID LONG CONSTRAINT CustomerID PRIMARY KEY, " & _
       "CompanyName TEXT (50), IntroDate DATETIME, " & _
       "CONSTRAINT IntroDateCheck CHECK (IntroDate <= Date()), " & _
       "CreditLimit CURRENCY DEFAULT 5000)"
   cmd.Execute

End Sub

</source>
   
  

Default Column value

   <source lang="vb">

Sub CreateDefault()

   Dim cmd As ADODB.rumand
   Set cmd = New ADODB.rumand
   cmd.ActiveConnection = CurrentProject.Connection
   cmd.rumandText = "CREATE TABLE Customers " & _
       "(CustomerID LONG CONSTRAINT CustomerID PRIMARY KEY, " & _
       "CompanyName TEXT (50), IntroDate DATETIME, " & _
       "CreditLimit CURRENCY DEFAULT 5000)"
   cmd.Execute

End Sub

</source>