Coleção de relações (DAO)
Aplica-se ao: Access 2013, Office 2013
Uma coleção Relations contém objetos Relation armazenados de um objeto Database (somente em bancos de dados do Microsoft Access).
Comentários
É possível usar o objeto Relation para criar novas relações e examinar relações existentes em seu banco de dados. Para adicionar um objeto Relation à coleção Relations, crie-o primeiramente com o método CreateRelation e, em seguida, acrescente-o à coleção Relations com o método Append. Isso salvará o objeto Relation quando você fechar o objeto Database. Para remover um objeto Relation da coleção, use o método Delete.
Para fazer referência a um objeto Relation em uma coleção por seu número ordinal ou por sua configuração de propriedade Name, use uma das seguintes formas de sintaxe:
Relations(0)
Relações("nome")
Relações! [nome]
Exemplo
Este exemplo mostra como um objeto Relation existente pode controlar a entrada de dados. O procedimento tenta adicionar um registro com um CódigoDaCategoria propositalmente incorreto; isso dispara a rotina de tratamento de erros.
Sub RelationX()
Dim dbsNorthwind As Database
Dim rstProducts As Recordset
Dim prpLoop As Property
Dim fldLoop As Field
Dim errLoop As Error
Set dbsNorthwind = OpenDatabase("Northwind.mdb")
Set rstProducts = dbsNorthwind.OpenRecordset("Products")
' Print a report showing all the different parts of
' the relation and where each part is stored.
With dbsNorthwind.Relations!CategoriesProducts
Debug.Print "Properties of " & .Name & " Relation"
Debug.Print " Table = " & .Table
Debug.Print " ForeignTable = " & .ForeignTable
Debug.Print "Fields of " & .Name & " Relation"
With .Fields!CategoryID
Debug.Print " " & .Name
Debug.Print " Name = " & .Name
Debug.Print " ForeignName = " & .ForeignName
End With
End With
' Attempt to add a record that violates the relation.
With rstProducts
.AddNew
!ProductName = "Trygve's Lutefisk"
!CategoryID = 10
On Error GoTo Err_Relation
.Update
On Error GoTo 0
.Close
End With
dbsNorthwind.Close
Exit Sub
Err_Relation:
' Notify user of any errors that result from
' the invalid data.
If DBEngine.Errors.Count > 0 Then
For Each errLoop In DBEngine.Errors
MsgBox "Error number: " & errLoop.Number & _
vbCr & errLoop.Description
Next errLoop
End If
Resume Next
End Sub
Este exemplo usa o método CreateRelation para criar um objeto Relation entre o TableDef Employees e o novo TableDef denominado Departments. Ele também demonstra como a criação de uma nova Relação também criará os Índices necessários na tabela estrangeira (o Índice DepartmentsEmployees na tabela Funcionários).
Sub CreateRelationX()
Dim dbsNorthwind As Database
Dim tdfEmployees As TableDef
Dim tdfNew As TableDef
Dim idxNew As Index
Dim relNew As Relation
Dim idxLoop As Index
Set dbsNorthwind = OpenDatabase("Northwind.mdb")
With dbsNorthwind
' Add new field to Employees table.
Set tdfEmployees = .TableDefs!Employees
tdfEmployees.Fields.Append _
tdfEmployees.CreateField("DeptID", dbInteger, 2)
' Create new Departments table.
Set tdfNew = .CreateTableDef("Departments")
With tdfNew
' Create and append Field objects to Fields
' collection of the new TableDef object.
.Fields.Append .CreateField("DeptID", dbInteger, 2)
.Fields.Append .CreateField("DeptName", dbText, 20)
' Create Index object for Departments table.
Set idxNew = .CreateIndex("DeptIDIndex")
' Create and append Field object to Fields
' collection of the new Index object.
idxNew.Fields.Append idxNew.CreateField("DeptID")
' The index in the primary table must be Unique in
' order to be part of a Relation.
idxNew.Unique = True
.Indexes.Append idxNew
End With
.TableDefs.Append tdfNew
' Create EmployeesDepartments Relation object, using
' the names of the two tables in the relation.
Set relNew = .CreateRelation("EmployeesDepartments", _
tdfNew.Name, tdfEmployees.Name, _
dbRelationUpdateCascade)
' Create Field object for the Fields collection of the
' new Relation object. Set the Name and ForeignName
' properties based on the fields to be used for the
' relation.
relNew.Fields.Append relNew.CreateField("DeptID")
relNew.Fields!DeptID.ForeignName = "DeptID"
.Relations.Append relNew
' Print report.
Debug.Print "Properties of " & relNew.Name & _
" Relation"
Debug.Print " Table = " & relNew.Table
Debug.Print " ForeignTable = " & _
relNew.ForeignTable
Debug.Print "Fields of " & relNew.Name & " Relation"
With relNew.Fields!DeptID
Debug.Print " " & .Name
Debug.Print " Name = " & .Name
Debug.Print " ForeignName = " & .ForeignName
End With
Debug.Print "Indexes in " & tdfEmployees.Name & _
" TableDef"
For Each idxLoop In tdfEmployees.Indexes
Debug.Print " " & idxLoop.Name & _
", Foreign = " & idxLoop.Foreign
Next idxLoop
' Delete new objects because this is a demonstration.
.Relations.Delete relNew.Name
.TableDefs.Delete tdfNew.Name
tdfEmployees.Fields.Delete "DeptID"
.Close
End With
End Sub