Trying to copy table relationships to new database file

try


  Set rel = db.CreateRelation(Name:="[rel.Name]", Table:="[rel.tblDataHeader]", ForeignTable:="[rel.tblDataDetail]", Attributes:=[rel.Attributes])
        rel.Fields.Append rel.CreateField("[fld.Name for relation]")
        rel.Fields("[fld.RECORD_NUMBER for relation]").ForeignName = "[fld.RECORD_NUMBER for relation]"
        db.Relations.Append rel

Am getting an error when I try to compile.  Variable not defined.

At

rel =

you need to declare rel
dim rel as dao.relation

also see this link CreateRelation as reference

I declared it with dim rel as dao.relation.

But the code didn't run - Runtime error 2465.  ... can't find the field '|1' referred to in your expression.

Code stopped at this line:

Set rel = db.CreateRelation(Name:="[rel.Name]", Table:="[rel.tblDataHeader]", ForeignTable:="[rel.tblDataDetail]", Attributes:=[rel.Attributes])

check the link the I posted above

I will.  It looks like totally different code.

I tried.  I pasted the code in the bottom of the code for the form that has the command button to onclick run this.  Isn't working.  I'm sure I have something messed up.

Private Function CreateRelation(tblDataHeader As String, _
                                RECORD_NUMBER As String, _
                                tblDataDetail As String, _
                                RECORD_NUMBER As String) As Boolean
On Error GoTo ErrHandler

    Dim db As DAO.Database
    Dim newRelation As DAO.Relation
    Dim relatingField As DAO.Field
    Dim RECORD_NUMBER As String
   
    relationUniqueName = tblDataHeader + "_" + RECORD_NUMBER + _
                         "__" + tblDataDetail + "_" + RECORD_NUMBER
   
'    Set db = CurrentDb()
   
    'Arguments for CreateRelation(): any unique name,
    'primary table, related table, attributes.
    Set newRelation = db.CreateRelation(relationUniqueName, _
                            tblDataHeader, tblDataDetail)
    'The field from the primary table.
    Set relatingField = newRelation.CreateField(RECORD_NUMBER)
    'Matching field from the related table.
    relatingField.ForeignName = RECORD_NUMBER
    'Add the field to the relation's Fields collection.
    newRelation.Fields.Append RECORD_NUMBER
    'Add the relation to the database.
    db.Relations.Append newRelation
   
'    Set db = Nothing
   
    CreateRelation = True
       
Exit Function

ErrHandler:
    Debug.Print Err.Description + " (" + relationUniqueName + ")"
    CreateRelation = False
End Function

Public Function CreateAllRelations()

    Dim db As DAO.Database
    Dim totalRelations As Integer
   
    Set db = CurrentDb()
    totalRelations = db.Relations.Count
    If totalRelations > 0 Then
        For i = totalRelations - 1 To 0 Step -1
            db.Relations.Delete (db.Relations(i).Name)
        Next i
        Debug.Print Trim(Str(totalRelations)) + " Relationships deleted!"
    End If
   
    Debug.Print "Creating Relations..."
   
    ''==========================
    ''Example
    'Employee Master to Employee CheckIn
    Debug.Print CreateRelation("tblDataHeader", "RECORD_NUMBER", _
                               "tblDataDetail", "RECORD_NUMBER")
   
    ''Orders to Order Details
'    Debug.Print CreateRelation("Orders", "No", _
                               "OrderDetails", "No")
    ''==========================
   
    totalRelations = db.Relations.Count
    Set db = Nothing
   
    Debug.Print Trim(Str(totalRelations)) + " Relationships created!"
    Debug.Print "Completed!"
End Function

When I try to compile I get duplicate declaration in project scope at :

Private Function CreateRelation(tblDataHeader As String, _
                                RECORD_NUMBER As String, _
                                tblDataDetail As String, _
                                RECORD_NUMBER As String) As Boolean

why did you comment this lines

'    Set db = CurrentDb()

'    Set db = Nothing


<When I try to compile I get duplicate declaration in project scope at :>
this   RECORD_NUMBER As String was repated
Private Function CreateRelation(tblDataHeader As String, _
                                 RECORD_NUMBER As String, _    '<<<<
                                 tblDataDetail As String, _
                                 RECORD_NUMBER As String) As Boolean  '<<<<<<

I actually tried to UNcomment it.  Still didn't work.

Here is all the code in the form.

Private Sub cmdArchiveTables_Click()

    If IsNull(Me.txtDate) Then
        MsgBox "You must enter a date."
        Me.txtDate.SetFocus
        Exit Sub
    End If

    If MsgBox("This function will archive data records per the date range you have specified.  Please be sure to create a backup file copy of your current working database before proceeding.  Do you wish to continue??", vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then

    Dim ws As Workspace
    Dim db As Database
    Dim LFilename As String
    Dim tblDataHeader As Object
    Dim tblDataDetail As Object
    Dim rel As DAO.Relation

   'Get default Workspace
    Set ws = DBEngine.Workspaces(0)

   'Path and file name for new mdb file
    LFilename = Me.txtFileNameAndLocation & ".accdb"
   
    MsgBox Me.txtFileNameAndLocation & ".accdb"

   'Make sure there isn't already a file with the name of the new database
    If Dir(LFilename) <> "" Then Kill LFilename

   'Create a new accdb file
    Set db = ws.CreateDatabase(LFilename, dbLangGeneral)

   'Export tables to new database
    DoCmd.TransferDatabase acExport, "Microsoft Access", LFilename, acTable, "qryHeaderRecordsToArchive", "tblDataHeader", False
    DoCmd.TransferDatabase acExport, "Microsoft Access", LFilename, acTable, "qryDetailRecordsToArchive", "tblDataDetail", False
   
    'Copy relationship between the two tables
    CreateAllRelations
'    Set rel = db.CreateRelation(Name:="[rel.Name]", Table:="[rel.tblDataHeader]", ForeignTable:="[rel.tblDataDetail]", Attributes:=[rel.Attributes])
'        rel.Fields.Append rel.CreateField("[fld.Name for relation]")
'        rel.Fields("[fld.RECORD_NUMBER for relation]").ForeignName = "[fld.RECORD_NUMBER for relation]"
'        db.Relations.Append rel

    db.Close
    DoCmd.Close acForm, "frmDateRangeForDataArchive"
   
    Set db = CurrentDb
   
    DoCmd.SetWarnings False
        DoCmd.OpenQuery "delqryRecordsToArchive"
    DoCmd.SetWarnings True
        Else
        Exit Sub
    End If

End Sub

Private Sub Form_Open(Cancel As Integer)

    Me.cmdFocus.SetFocus

End Sub

Private Function CreateRelation(tblDataHeader As String, _
                                RECORD_NUMBER As String, _
                                tblDataDetail As String, _
                                RECORD_NUMBER As String) As Boolean
On Error GoTo ErrHandler

    Dim db As DAO.Database
    Dim newRelation As DAO.Relation
    Dim relatingField As DAO.Field
    Dim RECORD_NUMBER As String
   
    relationUniqueName = tblDataHeader + "_" + RECORD_NUMBER + _
                         "__" + tblDataDetail + "_" + RECORD_NUMBER
   
    Set db = CurrentDb()
   
    'Arguments for CreateRelation(): any unique name,
    'primary table, related table, attributes.
    Set newRelation = db.CreateRelation(relationUniqueName, _
                            tblDataHeader, tblDataDetail)
    'The field from the primary table.
    Set relatingField = newRelation.CreateField(RECORD_NUMBER)
    'Matching field from the related table.
    relatingField.ForeignName = RECORD_NUMBER
    'Add the field to the relation's Fields collection.
    newRelation.Fields.Append RECORD_NUMBER
    'Add the relation to the database.
    db.Relations.Append newRelation
   
    Set db = Nothing
   
    CreateRelation = True
       
Exit Function

ErrHandler:
    Debug.Print Err.Description + " (" + relationUniqueName + ")"
    CreateRelation = False
End Function

Public Function CreateAllRelations()

    Dim db As DAO.Database
    Dim totalRelations As Integer
    Dim i As Integer
   
    Set db = CurrentDb()
    totalRelations = db.Relations.Count
    If totalRelations > 0 Then
        For i = totalRelations - 1 To 0 Step -1
            db.Relations.Delete (db.Relations(i).Name)
        Next i
        Debug.Print Trim(Str(totalRelations)) + " Relationships deleted!"
    End If
   
    Debug.Print "Creating Relations..."
   

    Debug.Print CreateRelation("tblDataHeader", "RECORD_NUMBER", _
                               "tblDataDetail", "RECORD_NUMBER")
   

   
    totalRelations = db.Relations.Count
    Set db = Nothing
   
    Debug.Print Trim(Str(totalRelations)) + " Relationships created!"
    Debug.Print "Completed!"
End Function

READ the COMMENTS.

I'm still trying to copy the relationships in the new database.  Here is the code I'm trying to use:

    Dim fld As Field
    
    Set rel = db.Relations("reltblDataDetailtblDataHeader")
    
    Set rel = db.CreateRelation("tblDataHeader", "tblDataHeader", "tblDataDetail", dbRelationUpdateCascade Or dbRelationDeleteCascade)
    
    Set fld = rel.CreateField("RECORD_NUMBER")
    fld.ForeignName = "RECORD_NUMBER"
    rel.Fields.Append fld

    db.Relations.Append rel

    Set fld = Nothing
    Set rel = Nothing

Select allOpen in new window

But it isn't working.

And here is the entire onclick code of the command button that executes all this code: (everything works fine when I comment out the above pasted code.

Private Sub cmdArchiveTables_Click()

    If IsNull(Me.txtDate) Then
        MsgBox "You must enter a date."
        Me.txtDate.SetFocus
        Exit Sub
    End If

    If MsgBox("This function will archive data records per the date range you have specified.  Please be sure to create a backup file copy of your current working database before proceeding.  Do you wish to continue??", vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then

    Dim ws As Workspace
    Dim db As Database
    Dim LFilename As String
    Dim tblDataHeader As Object
    Dim tblDataDetail As Object
    Dim rel As DAO.Relation

   'Get default Workspace
    Set ws = DBEngine.Workspaces(0)

   'Path and file name for new mdb file
    LFilename = Me.txtFileNameAndLocation & ".accdb"
    
'    MsgBox Me.txtFileNameAndLocation & ".accdb"

   'Make sure there isn't already a file with the name of the new database
    If Dir(LFilename) <> "" Then Kill LFilename

   'Create a new accdb file
    Set db = ws.CreateDatabase(LFilename, dbLangGeneral)

   'Export tables to new database
    DoCmd.TransferDatabase acExport, "Microsoft Access", LFilename, acTable, "qryHeaderRecordsToArchive", "tblDataHeader", False
    DoCmd.TransferDatabase acExport, "Microsoft Access", LFilename, acTable, "qryDetailRecordsToArchive", "tblDataDetail", False
    
    
    
    'Copy relationship between the two tables
    Dim fld As Field
    
    Set rel = db.Relations("reltblDataDetailtblDataHeader")
    
    Set rel = db.CreateRelation("tblDataHeader", "tblDataHeader", "tblDataDetail", dbRelationUpdateCascade Or dbRelationDeleteCascade)
    
    Set fld = rel.CreateField("RECORD_NUMBER")
    fld.ForeignName = "RECORD_NUMBER"
    rel.Fields.Append fld

    db.Relations.Append rel

    Set fld = Nothing
    Set rel = Nothing

    db.Close
    DoCmd.Close acForm, "frmDateRangeForDataArchive"
   
    Set db = CurrentDb
   
    DoCmd.SetWarnings False
        DoCmd.OpenQuery "delqryRecordsToArchive"
    DoCmd.SetWarnings True
        Else
        Exit Sub
    End If

End Sub

Select allOpen in new window