Storing and recreating relations in Access

I'm wondering if it is possible to use VBA to store, delete and recreate relationships on tables in Access VBA? The deletion part is easy, but how to store it in such a way as to be able to restore it after it's been deleted is where I get stuck.

I originally wanted to know so that I could bulk copy certain tables from one database into another copy of that database. I ran into trouble as the ref. integrity on the tables was interfering with the inserts. I thought about trying to store then delete the relations, insert the data, then restore the relations using DAO.

After thinking about it and trying to come up with some code for it, I abandoned the idea and inserted it in a different way to avoid the issue altogether. However, after the fact, I was pondering if what I had been trying is doable.

Any thoughts?

EDIT: Here's the code I started to write.

Private Sub Save_Click()
    Dim db As DAO.Database

    Set db = CurrentDb
    'Save db.Relations somehow as SavedRelations
End Sub

Private Sub Delete_Cli开发者_C百科ck()
    Dim db As DAO.Database
    Dim rel As DAO.Relation

    Set db = CurrentDb

    For Each rel In db.Relations
        db.Relations.Delete (rel.Name)
    Next
End Sub

Private Sub Restore_Click()
    Dim db As DAO.Database
    Dim rel As DAO.Relation
    Dim newRel As DAO.Relation

    For Each rel In SavedRelations 'Stored relations from the Save sub
        Set newRel = db.CreateRelation(rel.Name, rel.table, rel.ForeignTable, rel.Attributes)
        For Each fld In rel.Fields
            newRel.Fields.Append fld
        Next
        db.Relations.Append newRel
    Next
End Sub

If you make a backup copy of your database before you delete the relations, you can copy them back later.

Private Sub Restore_Click()
    Dim db As DAO.Database
    Dim dbBackup As DAO.Database
    Dim rel As DAO.Relation
    Dim newRel As DAO.Relation

    Set db = CurrentDb()
    Set dbBackup = OpenDatabase("C:\temp\backup.mdb")
    For Each rel In dbBackup.Relations 
        Set newRel = db.CreateRelation(rel.Name, rel.table, rel.ForeignTable, _
            rel.Attributes)
        For Each fld In rel.Fields
            newRel.Fields.Append newRel.CreateField(fld.Name)
            newRel.Fields(fld.Name).ForeignName = _
                rel.Fields(fld.Name).ForeignName
        Next fld
        db.Relations.Append newRel
    Next rel
    Set fld = Nothing
    Set rel = Nothing
    Set dbBackup = Nothing
    Set db = Nothing
End Sub

The following code will create a classic parent to child relationship

  Dim nRel          As DAO.Relation
  Dim db            As DAO.Database

  Set db = CurrentDb

  Set nR = db.CreateRelation("ContactIDRI", "tblContacts", _
                             "tblChildren", dbRelationDeleteCascade + dbRelationLeft)

  nR.Fields.Append nR.CreateField("ContactID")        ' parent table PK
  nR.Fields("ContactID").ForeignName = "Contact_ID"   ' child table FK
  db.Relations.Append nR
  db.Relations.Refresh

Nice work HansUp! I modified it slightly to allow for a late-binding file browser. Sorry guys ... it took me a few edits to get the hang of these "code block" instructions. Hopefully it's right now:(

    Function selectFile()
'Late binding version of selectFile
'No MS Office Object references needed
'''''''''''''''''''''''''''''''''''''''
'http://www.minnesotaithub.com/2015/11/solved-late-binding-file-dialog-vba-example/
Dim fd As Object
Set fd = Application.FileDialog(3)

With fd
    If .Show Then
        selectFile = .SelectedItems(1)
    Else
        End
    End If
End With

Set fd = Nothing
End Function


    Public Function fRestoreRelationships()
'http://stackoverflow.com/questions/4028672/storing-and-recreating-relations-in-access

Dim db As DAO.Database
Dim dbBackup As DAO.Database
Dim rel As DAO.Relation
Dim newRel As DAO.Relation
Dim strBackupPath As String
Dim Msg As String
Dim CR As String
CR = vbCrLf
Msg = ""
Msg = Msg & "This procedure restores the relationships from a previous backup." & CR & CR
Msg = Msg & "If you would like to proceed with this operation, " & CR
Msg = Msg & "Please click on the [OK] button " & CR
Msg = Msg & "Otherwise click [Cancel] to exit this pocedure."

If MsgBox(Msg, vbOKCancel, "Proceed?") = vbOK Then

        strBackupPath = selectFile 'Calls a FileBrowser Dialog and returns a string value
        Set db = CurrentDb()
        Set dbBackup = OpenDatabase(strBackupPath)
        For Each rel In dbBackup.Relations
            Set newRel = db.CreateRelation(rel.Name, rel.Table, rel.ForeignTable, _
                rel.Attributes)
            For Each fld In rel.Fields
                newRel.Fields.Append newRel.CreateField(fld.Name)
                newRel.Fields(fld.Name).ForeignName = _
                    rel.Fields(fld.Name).ForeignName
            Next fld
            db.Relations.Append newRel
        Next rel
End If

Set fld = Nothing
Set rel = Nothing
Set dbBackup = Nothing
Set db = Nothing
End Function