You may be able to adapt the functions I'll list below to your purposes. I
haven't tested them exhaustively, but they seem to work. Note: the routine
"subDisplayAndLogError" is not included here, but you can replace it with
any error-reporting code you like. Beware of newsreader-produced line wrap.
'---- start of code----
Function fncBackupRelationships() As Boolean
' Backup the current relationships into user tables (prior to deleting
them).
' Return True if the relationships were successfully backed up, False
(with
' error message and log entry) if not.
On Error GoTo Err_fncBackupRelationships
Dim db As DAO.Database
Dim rel As DAO.Relation
Dim fld As DAO.Field
Dim strSQL As String
Dim lngBackupCount As Long
Set db = CurrentDb
' Delete the backup table we'll be (re-)creating.
On Error Resume Next 'disable error-handling
db.TableDefs.Delete "USysBackupRelationships"
db.TableDefs.Delete "USysBackupRelationshipFields"
On Error GoTo Err_fncBackupRelationships 'restore error-handling
strSQL = "CREATE TABLE USysBackupRelationships (" & _
"RelationName TEXT(255), TableName TEXT(255), " & _
"ForeignTable TEXT(255), " & _
"Attributes INTEGER);"
db.Execute strSQL, dbFailOnError
strSQL = "CREATE TABLE USysBackupRelationshipFields (" & _
"RelationName TEXT(255), FieldName TEXT(255), ForeignFieldName
TEXT(255));"
db.Execute strSQL, dbFailOnError
For Each rel In db.Relations
With rel
If Left(.Name & "XXXX", 4) = "MSys" Then
'Debug.Print "--> Skipping " & .Name
Else
'Debug.Print "*** Backing up " & .Name
strSQL = _
"INSERT INTO USysBackupRelationships (" & _
"RelationName, TableName, ForeignTable, " & _
"Attributes) " & _
"VALUES (" & Chr(34) & .Name & Chr(34) & _
", " & Chr(34) & .Table & Chr(34) & _
", " & Chr(34) & .ForeignTable & Chr(34) & _
", " & .Attributes & ");"
db.Execute strSQL, dbFailOnError
For Each fld In .Fields
'Debug.Print fld.Name, fld.ForeignName
strSQL = _
"INSERT INTO USysBackupRelationshipFields (" & _
"RelationName, FieldName, ForeignFieldName) " &
_
"VALUES (" & Chr(34) & .Name & Chr(34) & _
", " & Chr(34) & fld.Name & Chr(34) & _
", " & Chr(34) & fld.ForeignName & Chr(34) &
");"
db.Execute strSQL, dbFailOnError
Next fld
' This relationship was successfully backed up.
lngBackupCount = lngBackupCount + 1
End If
End With
Next rel
fncBackupRelationships = True
RefreshDatabaseWindow
Exit_fncBackupRelationships:
On Error Resume Next
If Not db Is Nothing Then
db.Close
Set db = Nothing
End If
Exit Function
Err_fncBackupRelationships:
fncBackupRelationships = False
subDisplayAndLogError _
"fncBackupRelationships", _
Err.Number, _
"Failed to back up relationships - " & Err.Description
Resume Exit_fncBackupRelationships
End Function
Function fncDeleteRelationships() As Boolean
' Delete the relationships that have been backed up. Note that
' relationships that have not been backed up will not be deleted.
On Error GoTo Err_fncDeleteRelationships
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rel As DAO.Relation
Dim strSQL As String
If Not fncUserIsInGroup("Admins") Then
DoCmd.Beep
MsgBox "You are not authorized to perform this function.", _
vbInformation, "Permission Denied"
Exit Function
End If
If MsgBox("Are you sure you want to delete relationships? " & _
"This is a potentially lethal operation!", _
vbExclamation + vbYesNo + vbDefaultButton2, _
"Are You Sure?") _
<> vbYes _
Then
Exit Function
End If
Set db = CurrentDb
strSQL = "SELECT RelationName FROM USysBackupRelationships;"
Set rs = db.OpenRecordset(strSQL)
With rs
Do Until .EOF
db.Relations.Delete !RelationName
.MoveNext
Loop
End With
fncDeleteRelationships = True
Exit_fncDeleteRelationships:
On Error Resume Next
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
If Not db Is Nothing Then
db.Close
Set db = Nothing
End If
Exit Function
Err_fncDeleteRelationships:
fncDeleteRelationships = False
subDisplayAndLogError _
"fncDeleteRelationships", _
Err.Number, _
"Failed to delete relationships - " & Err.Description
Resume Exit_fncDeleteRelationships
End Function
Function fncRestoreRelationships() As Boolean
' Restore the relationships that have been backed up.
On Error GoTo Err_fncRestoreRelationships
Dim db As DAO.Database
Dim rsRel As DAO.Recordset
Dim rsFld As DAO.Recordset
Dim rel As DAO.Relation
Dim fld As DAO.Field
Dim strSQL As String
Set db = CurrentDb
strSQL = "SELECT * FROM USysBackupRelationships;"
Set rsRel = db.OpenRecordset(strSQL)
With rsRel
Do Until .EOF
Set rel = db.CreateRelation( _
!RelationName, !TableName, !ForeignTable, !Attributes)
strSQL = _
"SELECT * FROM USysBackupRelationshipFields " & _
"WHERE RelationName = " & Chr(34) & !RelationName & Chr(34)
& ";"
Set rsFld = db.OpenRecordset(strSQL)
With rsFld
Do Until .EOF
Set fld = rel.CreateField(!FieldName)
fld.ForeignName = !ForeignFieldName
rel.Fields.Append fld
.MoveNext
Loop
.Close
End With
db.Relations.Append rel
.MoveNext
Loop
End With
fncRestoreRelationships = True
Exit_fncRestoreRelationships:
On Error Resume Next
If Not rsRel Is Nothing Then
rsRel.Close
Set rsRel = Nothing
End If
If Not db Is Nothing Then
db.Close
Set db = Nothing
End If
Exit Function
Err_fncRestoreRelationships:
fncRestoreRelationships = False
subDisplayAndLogError _
"fncRestoreRelationships", _
Err.Number, _
"Failed to restore relationships - " & Err.Description
Resume Exit_fncRestoreRelationships
End Function
'---- end of code----
--
Dirk Goldgar, MS Access MVP
www.datagnostics.com
(to reply via e-mail, remove NOSPAM from address)
Quote:
> Hi everyone,
> I have an Access 97 database (called, for simplicity, A), which I am using
> to move the tables from database B to database C (both Access 97
databases).
> I am doing this by importing the tables from B into A, and then exporting
> them from A to C.
> However, I also need to move the relationships defined in B into C. I have
> tried using recordsets to copy the data in MSysRelationships, and although
I
> can read this data from B, I cannot write it to C as it appears to be a
> read-only object.
> Can anyone suggest a way of updating the relationships in database B from
> the details in database C (without actually running the database B and
> manually importing the tables and relationships)?
> Many thanks,
> Matt
Moving table relationships from database to database