Create Relationship

[PhilOfWalton]

I have a Db with (for the moment) tables in my FE database together with linked Excel files.

In the relationship window, I can establish a relationship between an "Access" table and the linked "Excel" table, but obviously can't establish referential integrity. I can live with that.

Using the following code

Public Function CreateRelationship(vPKTableName As String, vPKFieldName As String, vFKTableName As String, vFKFieldName As String, Optional RelName As String) As Boolean
'?CreateRelationship("TblPSysJoinExcelProjectsProject", "ProjectID", "TblExcelProject", "ONB Project", "APS"
    Dim MyDb As DAO.Database
    Dim newRelation As DAO.Relation
    Dim relatingField As DAO.Field
 
    On Error GoTo CreateRelationship_Err
 
    If IsMissing(RelName) Or RelName = "" Then
        RelName = vPKTableName + "_" + vPKFieldName + "__" + vFKTableName + "_" + vFKFieldName
    End If
 
    Set MyDb = CurrentDb()
 
    'Arguments for CreateRelation(): any unique name,
    'primary table, related table, attributes.
    Set newRelation = MyDb.CreateRelation(RelName, vPKTableName, vFKTableName)
    'The field from the primary table.
    Set relatingField = newRelation.CreateField(vPKFieldName)
    'Matching field from the related table.
    relatingField.ForeignName = vFKFieldName
    'Add the field to the relation's Fields collection.
    newRelation.Fields.Append relatingField
    'Add the relation to the database.
    MyDb.Relations.Append newRelation
 
    Set MyDb = Nothing
 
    CreateRelationship = True
 
Exit Function
 
CreateRelationship_Err:
    Debug.Print "Error: " & Err & "   " & Err.Description + " (" + RelName + ")"
 
End Function

I get Error: 3057 Operation not supported on linked tables. (APS)
on the line starting "Set newRelation = ...."

If I can set the relationship manually, why not in code? How do I get round this?

Thanks

Phil

[ADezii]

I am not exactly sure why this Error is occurring, but there is a work-a-round. How viable this solution is will depend on your specific circumstances.

1. Create a Table that is exactly the same structurally as your Linked Excel Table. This will be your Append Table (let's call it tblAppend).
2. DELETE all Records in tblAppend before attempting to create any Relation, (ref Line# 15), as in:
   

   CurrentDB.Execute "DELETE * FROM tblAppend", dbFailOnError

3. Create an Append Query that will Append all Data in the Linked Excel Table to the empty tblAppend (SET/RESET WARNINGS).
4. Refer to Lines# 17-21.
5. You can now execute Code that will create a Relation between FieldX in the Access Table and FieldY in tblAppend.
6. Also, you can now enforce Referential Integrity, Cascade Deletes, etc. between these two Tables.
7. Key Logic in this approach is to check if the Relation already exists, and if it does, DELETE then recreate it (ref Line# 44).
8. Revised Function Definition:
   

   Public Function CreateRelationshipDemo(vPKTableName As String, vPKFieldName As String, vFKTableName As String, vFKFieldName As String, Optional RelName As String) As Boolean
    '?CreateRelationship("TblPSysJoinExcelProjectsProject", "ProjectID", "TblExcelProject", "ONB Project", "APS"
   Dim MyDb As DAO.Database
   Dim newRelation As DAO.Relation
   Dim relatingField As DAO.Field
    
   On Error GoTo CreateRelationship_Err
    
   If IsMissing(RelName) Or RelName = "" Then
     RelName = vPKTableName + "_" + vPKFieldName + "__" + vFKTableName + "_" + vFKFieldName
   End If
    
   Set MyDb = CurrentDb()
    
   CurrentDb.Execute "DELETE * FROM Employees2", dbFailOnError
    
   With DoCmd
     .SetWarnings False
     .OpenQuery "qryAppendDataFromLinkedExcelTable", acViewNormal
     .SetWarnings True
   End With
    
   Set newRelation = MyDb.CreateRelation(RelName, vPKTableName, vFKTableName)
       newRelation.Attributes = dbRelationDeleteCascade    'Cascade DELETES
    
   'The field from the primary table.
   Set relatingField = newRelation.CreateField(vPKFieldName)
    
   'Matching field from the related table.
   relatingField.ForeignName = vFKFieldName
    
   'Add the field to the relation's Fields collection.
   newRelation.Fields.Append relatingField
    
   'Add the relation to the database.
   MyDb.Relations.Append newRelation
    
   Set MyDb = Nothing
    
   CreateRelationshipDemo = True
    
   Exit Function
    
   CreateRelationship_Err:
     If Err.Number = 3012 Then     'Relation already exists, DELETE it and start over
       MyDb.Relations.Delete newRelation.Name
         Resume
     Else
       Debug.Print "Error: " & Err & "   " & Err.Description + " (" + RelName + ")"
     End If
   End Function

9. Sample Function Call:
   

   If CreateRelationshipDemo("Employees", "ID", "Employees2", "ID", "MyRelation") = True Then
     MsgBox "Success"
   Else
     MsgBox "Failure"
   End If
    

P.S. - If you are interested, I have a functional Demo that you can reference. Just let me know.

[NeoPa]

Hi ADezii.

Just to be clear, can I confirm that you're proposing to create a Jet/ACE copy of the Excel table and then creating a Relationship using that instead?

[NeoPa]

Hi Phil.

Not really sure why that wouldn't work if I'm honest. I'd expect the code and the interface to work similarly and consistently. It seems you've found they don't :-(

[ADezii]

Just to be clear, can I confirm that you're proposing to create a Jet/ACE copy of the Excel table and then creating a Relationship using that instead?

First and foremost, always a pleasure to see you alive and well and as sharp as ever! Regarding your statement, you are correct. Depending on Phil's unique situation, it may/may not be a suitable solution. Granted, it is a little clumsy.

[NeoPa]

I can't deny I also get a little thrill when I see you post my friend.

[PhilOfWalton]

Thanks guys for your input.
I am reluctant to go down ADezii's route because, after setting up the relationship manually, the access portion should stay in "sync" with the Excel files.

Certainly MsysRelationships shows the relationship after it has been set up manually, and using VBA the relationship can be deleted, so that indicates there is not a problem with write permissions to MSysRelationships.

Is this an Access bug?

Phil

[twinnyfo]

It's not a bug... It's a "feature"!

:-)

[ADezii]

after setting up the relationship manually, the access portion should stay in "sync" with the Excel files.

You are correct in stating that my solution would be useless in this case because you would lose the synchronization with the Excel File.

[ADezii]

1. It took a little patience, but I do believe that I have arrived at a solution, namely: Creating a Relationship between an Access Table and a Linked Excel Spreadsheet (RI not enforced):
2. Revised Function Definition:
   

   Public Function CreateRelationship(vPKTableName As String, vPKFieldName As String, vFKTableName As String, vFKFieldName As String, Optional RelName As String) As Boolean
   Dim MyDb As DAO.Database
   Dim newRelation As DAO.Relation
   Dim relatingField As DAO.Field
    
   On Error GoTo CreateRelationship_Err
    
   If IsMissing(RelName) Or RelName = "" Then
     RelName = vPKTableName + "_" + vPKFieldName + "__" + vFKTableName + "_" + vFKFieldName
   End If
    
   Set MyDb = CurrentDb()
    
   'Arguments for CreateRelation(): any unique name,
   'primary table, related table, attributes.
   Set newRelation = MyDb.CreateRelation(RelName, vPKTableName, vFKTableName, dbRelationDontEnforce)
    
   'The field from the primary table.
   Set relatingField = newRelation.CreateField(vPKFieldName)
    
   'Matching field from the related table.
   relatingField.ForeignName = vFKFieldName
    
   'Add the field to the relation's Fields collection.
   newRelation.Fields.Append relatingField
    
   'Add the relation to the database.
   MyDb.Relations.Append newRelation
    
   Set MyDb = Nothing
    
   CreateRelationship = True
   Exit Function
    
   CreateRelationship_Err:
     If Err.Number = 3012 Then     'Relation already exists, DELETE it and start over
       MyDb.Relations.Delete newRelation.Name
         Resume
     Else
       Debug.Print "Error: " & Err.Number & "  " & Err.Description & " (" & RelName & ")"
     End If
   End Function

3. Sample Function Call:
   

   If CreateRelationship("Employees", "ID", "Employees_Excel", "ID", "MyRelation") = True Then
     MsgBox "Success"
   Else
     MsgBox "Failure"
   End If
    

4. Kindly let me know if this works out for you.

[PhilOfWalton]

Great, ADezii, works a treat.

It looks as if missing out the dbRelationDontEnforce was the main culprit.

Thanks again

Phil

[ADezii]

After some thought I guess it makes sense:

1. You can create the Relationship manually, but the option to enforce RI is disabled since you cannot set Referential Integrity on an External, Linked Object.
2. It appears that the CreateRelation() Method enforces RI by Default. The generated Error is not in creating the Relationship, but enforcing RI on it.
3. By setting the dbRelationDontEnforce, the Method is explicitly told not to enforce RI thus avoiding the Error.
4. In any event, good luck with your Project!

[twinnyfo]

ADezii,

That was a great explanation! That makes a lot of sense and gives me another tool in my kit. Thanks to you, too, Phil, for raising the issue--always pushing the envelope!

[ADezii]

Thanks twinnyfo for the compliment. I actually thought that my explanation was as clear as mud.(LOL).