[AccessD] Import Relationships

Arthur....

I use the following 2 routines.  First, I delete all the relationships in
the "bad" database  (DeleteRelations).  The I use ImportRelations to copy
the relationships from the "good" database to the "bad" database.

This code was all cloned from the Web.

Barb



Private Sub DeleteRelations()
On Error GoTo Err_Handler

    Dim ThisDb As Database
    Dim ThisRel As Relation
    Dim i As Integer
    Dim c As Integer

    Set ThisDb = CurrentDb()

    c = ThisDb.Relations.Count - 1
    For i = c To 0 Step -1
       Set ThisRel = ThisDb.Relations(i)
       ThisDb.Relations.Delete ThisRel.Name
    Next i

    MsgBox "Relationships deleted successfully", vbInformation, "BE Update"

Exit_DeleteRelations:
    Exit Sub

Err_Handler:
    MsgBox Err.Number & ":" & Err.Description
    Resume Next

End Sub


Function ImportRelations(DbName As String) As Integer
On Error GoTo Err_Handler
'  How to execute --- ImportRelations("C:\Program Files\Microsoft
Office\Office\Samples\Northwind.mdb")

'------------------------------------------------------------------
' PURPOSE: Imports relationships where table names and field names
'          match.
' ACCEPTS: The name of the external database as a string.
' RETURNS: The number of relationships imported as an integer.
'------------------------------------------------------------------

    Dim ThisDb As Database, ThatDB As Database
    Dim ThisRel As Relation, ThatRel As Relation
    Dim ThisField As Field, ThatField As Field
    Dim Cr As String, i As Integer, cnt As Integer, RCount As Integer
    Dim j As Integer
    Dim ErrBadField As Integer

    Cr$ = Chr$(13)
    RCount = 0

    Set ThisDb = CurrentDb()
    Set ThatDB = DBEngine.Workspaces(0).OpenDatabase(DbName$)

    ' Loop through all existing relationships in the external database.
    For i = 0 To ThatDB.Relations.Count - 1
       Set ThatRel = ThatDB.Relations(i)

       ' Create 'ThisRel' using values from 'ThatRel'.
       Set ThisRel = ThisDb.CreateRelation(ThatRel.Name, _
          ThatRel.Table, ThatRel.ForeignTable, ThatRel.Attributes)

       ' Set bad field flag to false.
       ErrBadField = False

       ' Loop through all fields in that relation.
       For j = 0 To ThatRel.Fields.Count - 1
          Set ThatField = ThatRel.Fields(j)

          ' Create 'ThisField' using values from 'ThatField'.
          Set ThisField = ThisRel.CreateField(ThatField.Name)
          ThisField.ForeignName = ThatField.ForeignName

          ' Check for bad fields.
          On Error Resume Next
          ThisRel.Fields.Append ThisField
          If Err <> False Then ErrBadField = True
          On Error GoTo 0
       Next j

       ' If any field of this relationship caused an error,
       ' do not add this relationship.
       If ErrBadField = True Then
            Debug.Print "Could not add relation " & ThisField.Name & "
between tables " & ThatRel.Table & " AND " & ThatRel.ForeignTable
          ' Something went wrong with the fields.
          ' Do not do anything.
       Else
          ' Try to append the relation.
          On Error Resume Next
          ThisDb.Relations.Append ThisRel
          If Err <> False Then
            Debug.Print "Could not add relation " & ThisField.Name & "
between tables " & ThatRel.Table & " AND " & ThatRel.ForeignTable
            ' Something went wrong with the relationship.
            ' Skip it.
          Else
            ' Keep count of successful imports.
            RCount = RCount + 1
          End If
          On Error GoTo 0
       End If
    Next i

    ' Close databases.
    ThisDb.Close
    ThatDB.Close

    ' Return number of successful imports.
    ImportRelations = RCount
    MsgBox "Relationships were added successfully", vbInformation, "BE
Update"

Exit_ImportRelations:
    Exit Function

Err_Handler:
    If Err.Number = 3201 Then
        MsgBox "Data must be set up correctly before relationships can be
created"
    ElseIf Err.Number = 3012 Then
        MsgBox "Relationship already exists"
    Else
        MsgBox Err.Number & ":" & Err.Description
    End If
    Resume Exit_ImportRelations

End Function



----- Original Message ----- 
From: "Arthur Fuller" <artful at rogers.com>
To: "Access Developers discussion and problem solving"
<accessd at databaseadvisors.com>
Sent: Friday, May 27, 2005 1:51 PM
Subject: [AccessD] Import Relationships


> I have two copies of a db. In one I have done much work on defining
> Rels. In the other (which contains more recent data) none of these defs
> exist. This is MDB, by the way. Is there a cool chunk of code that will
> allow me to import the Rels? Should I just delete everything in db2's
> rels table then import everything from db1's table? Will that work?
>
> Arthur
>
>
>
> -- 
> No virus found in this outgoing message.
> Checked by AVG Anti-Virus.
> Version: 7.0.322 / Virus Database: 267.0.0 - Release Date: 5/27/2005
>
> -- 
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com