By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
435,426 Members | 3,338 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 435,426 IT Pros & Developers. It's quick & easy.

Create Relationship

PhilOfWalton
Expert 100+
P: 1,430
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
Expand|Select|Wrap|Line Numbers
  1. Public Function CreateRelationship(vPKTableName As String, vPKFieldName As String, vFKTableName As String, vFKFieldName As String, Optional RelName As String) As Boolean
  2. '?CreateRelationship("TblPSysJoinExcelProjectsProject", "ProjectID", "TblExcelProject", "ONB Project", "APS"
  3.     Dim MyDb As DAO.Database
  4.     Dim newRelation As DAO.Relation
  5.     Dim relatingField As DAO.Field
  6.  
  7.     On Error GoTo CreateRelationship_Err
  8.  
  9.     If IsMissing(RelName) Or RelName = "" Then
  10.         RelName = vPKTableName + "_" + vPKFieldName + "__" + vFKTableName + "_" + vFKFieldName
  11.     End If
  12.  
  13.     Set MyDb = CurrentDb()
  14.  
  15.     'Arguments for CreateRelation(): any unique name,
  16.     'primary table, related table, attributes.
  17.     Set newRelation = MyDb.CreateRelation(RelName, vPKTableName, vFKTableName)
  18.     'The field from the primary table.
  19.     Set relatingField = newRelation.CreateField(vPKFieldName)
  20.     'Matching field from the related table.
  21.     relatingField.ForeignName = vFKFieldName
  22.     'Add the field to the relation's Fields collection.
  23.     newRelation.Fields.Append relatingField
  24.     'Add the relation to the database.
  25.     MyDb.Relations.Append newRelation
  26.  
  27.     Set MyDb = Nothing
  28.  
  29.     CreateRelationship = True
  30.  
  31. Exit Function
  32.  
  33. CreateRelationship_Err:
  34.     Debug.Print "Error: " & Err & "   " & Err.Description + " (" + RelName + ")"
  35.  
  36. 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
Dec 8 '18 #1

✓ answered by 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:
    Expand|Select|Wrap|Line Numbers
    1. Public Function CreateRelationship(vPKTableName As String, vPKFieldName As String, vFKTableName As String, vFKFieldName As String, Optional RelName As String) As Boolean
    2. Dim MyDb As DAO.Database
    3. Dim newRelation As DAO.Relation
    4. Dim relatingField As DAO.Field
    5.  
    6. On Error GoTo CreateRelationship_Err
    7.  
    8. If IsMissing(RelName) Or RelName = "" Then
    9.   RelName = vPKTableName + "_" + vPKFieldName + "__" + vFKTableName + "_" + vFKFieldName
    10. End If
    11.  
    12. Set MyDb = CurrentDb()
    13.  
    14. 'Arguments for CreateRelation(): any unique name,
    15. 'primary table, related table, attributes.
    16. Set newRelation = MyDb.CreateRelation(RelName, vPKTableName, vFKTableName, dbRelationDontEnforce)
    17.  
    18. 'The field from the primary table.
    19. Set relatingField = newRelation.CreateField(vPKFieldName)
    20.  
    21. 'Matching field from the related table.
    22. relatingField.ForeignName = vFKFieldName
    23.  
    24. 'Add the field to the relation's Fields collection.
    25. newRelation.Fields.Append relatingField
    26.  
    27. 'Add the relation to the database.
    28. MyDb.Relations.Append newRelation
    29.  
    30. Set MyDb = Nothing
    31.  
    32. CreateRelationship = True
    33. Exit Function
    34.  
    35. CreateRelationship_Err:
    36.   If Err.Number = 3012 Then     'Relation already exists, DELETE it and start over
    37.     MyDb.Relations.Delete newRelation.Name
    38.       Resume
    39.   Else
    40.     Debug.Print "Error: " & Err.Number & "  " & Err.Description & " (" & RelName & ")"
    41.   End If
    42. End Function
  3. Sample Function Call:
    Expand|Select|Wrap|Line Numbers
    1. If CreateRelationship("Employees", "ID", "Employees_Excel", "ID", "MyRelation") = True Then
    2.   MsgBox "Success"
    3. Else
    4.   MsgBox "Failure"
    5. End If
    6.  
  4. Kindly let me know if this works out for you.

Share this Question
Share on Google+
13 Replies


ADezii
Expert 5K+
P: 8,638
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:
    Expand|Select|Wrap|Line Numbers
    1. 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:
    Expand|Select|Wrap|Line Numbers
    1. Public Function CreateRelationshipDemo(vPKTableName As String, vPKFieldName As String, vFKTableName As String, vFKFieldName As String, Optional RelName As String) As Boolean
    2.  '?CreateRelationship("TblPSysJoinExcelProjectsProject", "ProjectID", "TblExcelProject", "ONB Project", "APS"
    3. Dim MyDb As DAO.Database
    4. Dim newRelation As DAO.Relation
    5. Dim relatingField As DAO.Field
    6.  
    7. On Error GoTo CreateRelationship_Err
    8.  
    9. If IsMissing(RelName) Or RelName = "" Then
    10.   RelName = vPKTableName + "_" + vPKFieldName + "__" + vFKTableName + "_" + vFKFieldName
    11. End If
    12.  
    13. Set MyDb = CurrentDb()
    14.  
    15. CurrentDb.Execute "DELETE * FROM Employees2", dbFailOnError
    16.  
    17. With DoCmd
    18.   .SetWarnings False
    19.   .OpenQuery "qryAppendDataFromLinkedExcelTable", acViewNormal
    20.   .SetWarnings True
    21. End With
    22.  
    23. Set newRelation = MyDb.CreateRelation(RelName, vPKTableName, vFKTableName)
    24.     newRelation.Attributes = dbRelationDeleteCascade    'Cascade DELETES
    25.  
    26. 'The field from the primary table.
    27. Set relatingField = newRelation.CreateField(vPKFieldName)
    28.  
    29. 'Matching field from the related table.
    30. relatingField.ForeignName = vFKFieldName
    31.  
    32. 'Add the field to the relation's Fields collection.
    33. newRelation.Fields.Append relatingField
    34.  
    35. 'Add the relation to the database.
    36. MyDb.Relations.Append newRelation
    37.  
    38. Set MyDb = Nothing
    39.  
    40. CreateRelationshipDemo = True
    41.  
    42. Exit Function
    43.  
    44. CreateRelationship_Err:
    45.   If Err.Number = 3012 Then     'Relation already exists, DELETE it and start over
    46.     MyDb.Relations.Delete newRelation.Name
    47.       Resume
    48.   Else
    49.     Debug.Print "Error: " & Err & "   " & Err.Description + " (" + RelName + ")"
    50.   End If
    51. End Function
  9. Sample Function Call:
    Expand|Select|Wrap|Line Numbers
    1. If CreateRelationshipDemo("Employees", "ID", "Employees2", "ID", "MyRelation") = True Then
    2.   MsgBox "Success"
    3. Else
    4.   MsgBox "Failure"
    5. End If
    6.  
P.S. - If you are interested, I have a functional Demo that you can reference. Just let me know.
Dec 8 '18 #2

NeoPa
Expert Mod 15k+
P: 31,494
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?
Dec 10 '18 #3

NeoPa
Expert Mod 15k+
P: 31,494
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 :-(
Dec 10 '18 #4

ADezii
Expert 5K+
P: 8,638
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.
Dec 10 '18 #5

NeoPa
Expert Mod 15k+
P: 31,494
I can't deny I also get a little thrill when I see you post my friend.
Dec 10 '18 #6

PhilOfWalton
Expert 100+
P: 1,430
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
Dec 11 '18 #7

twinnyfo
Expert Mod 2.5K+
P: 3,284
It's not a bug... It's a "feature"!

:-)
Dec 11 '18 #8

ADezii
Expert 5K+
P: 8,638
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.
Dec 11 '18 #9

ADezii
Expert 5K+
P: 8,638
  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:
    Expand|Select|Wrap|Line Numbers
    1. Public Function CreateRelationship(vPKTableName As String, vPKFieldName As String, vFKTableName As String, vFKFieldName As String, Optional RelName As String) As Boolean
    2. Dim MyDb As DAO.Database
    3. Dim newRelation As DAO.Relation
    4. Dim relatingField As DAO.Field
    5.  
    6. On Error GoTo CreateRelationship_Err
    7.  
    8. If IsMissing(RelName) Or RelName = "" Then
    9.   RelName = vPKTableName + "_" + vPKFieldName + "__" + vFKTableName + "_" + vFKFieldName
    10. End If
    11.  
    12. Set MyDb = CurrentDb()
    13.  
    14. 'Arguments for CreateRelation(): any unique name,
    15. 'primary table, related table, attributes.
    16. Set newRelation = MyDb.CreateRelation(RelName, vPKTableName, vFKTableName, dbRelationDontEnforce)
    17.  
    18. 'The field from the primary table.
    19. Set relatingField = newRelation.CreateField(vPKFieldName)
    20.  
    21. 'Matching field from the related table.
    22. relatingField.ForeignName = vFKFieldName
    23.  
    24. 'Add the field to the relation's Fields collection.
    25. newRelation.Fields.Append relatingField
    26.  
    27. 'Add the relation to the database.
    28. MyDb.Relations.Append newRelation
    29.  
    30. Set MyDb = Nothing
    31.  
    32. CreateRelationship = True
    33. Exit Function
    34.  
    35. CreateRelationship_Err:
    36.   If Err.Number = 3012 Then     'Relation already exists, DELETE it and start over
    37.     MyDb.Relations.Delete newRelation.Name
    38.       Resume
    39.   Else
    40.     Debug.Print "Error: " & Err.Number & "  " & Err.Description & " (" & RelName & ")"
    41.   End If
    42. End Function
  3. Sample Function Call:
    Expand|Select|Wrap|Line Numbers
    1. If CreateRelationship("Employees", "ID", "Employees_Excel", "ID", "MyRelation") = True Then
    2.   MsgBox "Success"
    3. Else
    4.   MsgBox "Failure"
    5. End If
    6.  
  4. Kindly let me know if this works out for you.
Dec 11 '18 #10

PhilOfWalton
Expert 100+
P: 1,430
Great, ADezii, works a treat.

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

Thanks again

Phil
Dec 11 '18 #11

ADezii
Expert 5K+
P: 8,638
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!
Dec 11 '18 #12

twinnyfo
Expert Mod 2.5K+
P: 3,284
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!
Dec 11 '18 #13

ADezii
Expert 5K+
P: 8,638
Thanks twinnyfo for the compliment. I actually thought that my explanation was as clear as mud.(LOL).
Dec 12 '18 #14

Post your reply

Sign in to post your reply or Sign up for a free account.