VBA/Excel/Access/Word/Access/TableDefs

Материал из VB Эксперт

Перейти к: навигация, поиск

Содержание

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