Barbara Ryan
BarbaraRyan at cox.net
Fri May 27 13:26:49 CDT 2005
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