Views

Histats

Vitrine

VBA Access - Gerenciando os Relacionamentos - VBA code for creating MS Access Relations

A funcionalidade abaixo permite automatizarmos a criação de relacionamentos entre tabelas.

Public Function CreateAllRelations()
    Dim db As DAO.Database
    Dim totalRelations As Integer
    
    Set db = CurrentDb()
    Let totalRelations = db.Relations.Count
    If totalRelations > 0 Then
        For i = totalRelations - 1 To 0 Step -1
            db.Relations.Delete (db.Relations(i).Name)
        Next i
        Debug.Print Trim(Str(totalRelations)) + " Relacionamentos deletados!"
    End If
    
    Debug.Print "Criando Relacionamentos..."
    
    ''Exemple
    'Relacionando Employee Master com Employee CheckIn
    Debug.Print CreateRelation("Employee", "Code", _
                                           "CheckIn", "Code")    
    ' Relacionando Orders com Order Details
    Debug.Print CreateRelation("Orders", "No", _
                               "OrderDetails", "No")
    
    totalRelations = db.Relations.Count
    Set db = Nothing    
    Debug.Print Trim(Str(totalRelations)) + " Relacionamentos criados!"
    Debug.Print "Completado!"
End Function

Private Function CreateRelation(primaryTableName As String, _
                                primaryFieldName As String, _
                                foreignTableName As String, _
                                foreignFieldName As String) As Boolean
On Error GoTo ErrHandler
    Dim db As DAO.Database
    Dim newRelation As DAO.Relation
    Dim relatingField As DAO.Field
    Dim relationUniqueName As String
    
    Let relationUniqueName = primaryTableName + "_" + primaryFieldName + _
                         "__" + foreignTableName + "_" + foreignFieldName
    
    Set db = CurrentDb()    
    'Argumentos para CreateRelation(): Qualquer nome único, 
    ' Tabela primária, tabela relacionada, atributos.
    Set newRelation = db.CreateRelation(relationUniqueName, _
                            primaryTableName, foreignTableName)
    ' O campo da tabela primária.
    Set relatingField = newRelation.CreateField(primaryFieldName)
    
    Let relatingField.ForeignName = foreignFieldName
    
    newRelation.Fields.Append relatingField
    
    db.Relations.Append newRelation    

    Set db = Nothing    

    Let CreateRelation = True        
Exit Function

ErrHandler:
    Debug.Print Err.Description + " (" + relationUniqueName + ")"
    CreateRelation = False
End Function

Tags: VBA, Access, relations,

✔ VBA Brazil®

✔ VBA Brazil®
brazilsalesforceeffectiveness@gmail.com
Related Posts Plugin for WordPress, Blogger...
diHITT - Notícias