VBA/Excel/Access/Word/Access/TableDefs

Материал из VB Эксперт
Версия от 15:46, 26 мая 2010; Admin (обсуждение | вклад) (1 версия)
(разн.) ← Предыдущая | Текущая версия (разн.) | Следующая → (разн.)
Перейти к: навигация, поиск

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>