VBA/Excel/Access/Word/Access/TableDefs — различия между версиями
Admin (обсуждение | вклад) м (1 версия) |
|
(нет различий)
|
Текущая версия на 15:46, 26 мая 2010
Содержание
Add new property to TableDef
<source lang="vb">
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
</source>
Create an index
<source lang="vb">
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
</source>
Create a relation
<source lang="vb">
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
</source>
Create new field 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("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
</source>
Database relations
<source lang="vb">
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
</source>
List table properties
<source lang="vb">
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
</source>
Reference column name from TableDefs
<source lang="vb">
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
</source>