Add new property to TableDef

Содержание

• 1 Add new property to TableDef
• 2 Create an index
• 3 Create a relation
• 4 Create new field with validation rule
• 5 Database relations
• 6 List table properties
• 7 Reference column name from TableDefs

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

Категория:

• Страницы с ошибками в подсветке синтаксиса