Storing and recreating relations in Access - ms-access

Question

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_Click()
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

Answer 1

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

Answer 2

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

Answer 3

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