VBA/Excel/Access/Word/Access/TableDefs

Add new property to TableDef

 
Sub exaUserDefinedProperty()
    Dim db As Database
    Dim tbl As TableDef
    Dim prp As Property
     
    Set db = CurrentDb
    Set tbl = db!BOOKS
     
    Set prp = tbl.CreateProperty("UserProperty", dbText, "Programming DAO is fun.")
    tbl.Properties.Append prp
    For Each prp In tbl.Properties
       Debug.Print prp.Name
       Debug.Print prp.Value
       Debug.Print prp.Type
       Debug.Print prp.Inherited
    Next prp
     
    Debug.Print tbl.Properties.Count
     
End Sub

Create an index

 
Sub exaCreateIndex()
    Dim db As Database
    Dim tdf As TableDef
    Dim idx As Index
    Dim fld As Field
     
    Set db = CurrentDb
    Set tdf = db.TableDefs!BOOKS
    Set idx = tdf.CreateIndex("PriceTitle")
    Set fld = idx.CreateField("Price")
    idx.Fields.Append fld
    Set fld = idx.CreateField("Title")
    idx.Fields.Append fld
    tdf.Indexes.Append idx
End Sub

Create a relation

 
Sub exaRelations()
    Dim db As Database
    Dim rel As Relation
    Dim fld As Field
     
    Set db = CurrentDb
    Set rel = db.CreateRelation("PublisherRegions", "PUBLISHERS", "SALESREGIONS")
    rel.Attributes = dbRelationUpdateCascade
    Set fld = rel.CreateField("PubID")
    fld.ForeignName = "PubID"
    rel.Fields.Append fld
    db.Relations.Append rel
End Sub

Create new field with validation rule

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

Database relations

 
Public Sub ShowRelations()
    Dim db        As Database      
    Dim relR        As Relation    
    Set db = CurrentDb()
    For Each relR In db.Relations
        Debug.Print relR.Table & " is related to " & relR.ForeignTable
    Next
End Sub

List table properties

 
Sub exaProperties()
    Dim db As Database
    Dim tbl As TableDef
    Dim prp As Property
     
    Set db = CurrentDb
    Set tbl = db!Employees
    For Each prp In tbl.Properties
       Debug.Print prp.Name
       Debug.Print prp.Value
       Debug.Print prp.Type
       Debug.Print prp.Inherited
     
    Next prp
    Debug.Print tbl.Properties.Count 
End Sub

Reference column name from TableDefs

 
Sub exaCurrentDb2()
    Dim dbOne, dbTwo As Database
    Dim fldNew As Field
    Dim str As String
    
    Set dbOne = CurrentDb
    Set dbTwo = CurrentDb
    For Each fldNew In dbOne.TableDefs!BOOKS.Fields
        Debug.Print fldNew.Name
    Next
    
    Set fldNew = dbOne.TableDefs!BOOKS.CreateField("NewField1", dbInteger)
    dbOne.TableDefs!BOOKS.Fields.Append fldNew
    
    Set fldNew = dbTwo.TableDefs!BOOKS.CreateField("NewField2", dbInteger)
    dbTwo.TableDefs!BOOKS.Fields.Append fldNew
    
    dbOne.TableDefs!BOOKS.Fields.Refresh
    
    For Each fldNew In dbOne.TableDefs!BOOKS.Fields
        Debug.Print fldNew.Name 
    Next
    For Each fldNew In dbTwo.TableDefs!BOOKS.Fields
        Debug.Print fldNew.Name
    Next
    dbOne.Close
    dbTwo.Close
End Sub