How to create relationships with DAO?

[deko]

As part of an upgrade routine, I need to delete all relations, drop and
import some tables, then reapply the relationships.

The error I'm getting is:

Error Number 3366: Cannot append a relation with no fields defined.

How do I save, retrieve and apply the fields that belong to each
relationship?

Here's how I save the relations:

Public Function SaveRelations()
Dim db As DAO.Database
Dim rstRel As DAO.Recordset
Dim rstTbl As DAO.Recordset
Dim tdf As DAO.TableDef
Dim rel As DAO.Relation
Dim strTbl As String
Dim strSql As String
Set db = CurrentDb()
Set rstRel = db.OpenRecordset("tblRelations")
strSql = "DELETE * FROM tblRelations;" 'clear previous list
db.Execute strSql, dbFailOnError
db.Relations.Refresh
For Each rel In db.Relations
Debug.Print "Saving Relationship " & rel.Name
With rel
rstRel.AddNew
rstRel!rel = .Name
rstRel!tbl = .Table
rstRel!FrnTbl = .ForeignTable
rstRel!Att = .Attributes
rstRel.Update
End With
Next
End Function

Here's how I apply the relations:

Public Function ApplyRelations()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim rel As DAO.Relation
Dim fld As DAO.Field
Dim strRel As String
Dim strFrnTbl As String
Dim strFld As String
Dim strFrnFld As String
Set db = CurrentDb
Set rst = db.OpenRecordset("tblRelations")
Do While Not rst.EOF
'create relations
Set rel = db.CreateRelation(rst!rel, rst!tbl, _
rst!FrnTbl, rst!Att)
'set field attributes
For Each fld In rel.Fields
strFld = fld.Name
strFrnFld = fld.ForeignName
rel.Fields.Append rel.CreateField(strFld)
rel.Fields(strFld).ForeignName = strFrnFld
Next
db.Relations.Append rel '<<=== error here * * *
Loop
db.Relations.Refresh
End Function

Should I use a second table to store the fields that belong to each
relation? How would I retrieve and apply the field properties in my
ApplyRelations function?

Thanks in advance.

[Tom van Stiphout]

On Mon, 15 Aug 2005 05:43:48 -0700, "deko" <de**@nospam.com> wrote:

In the FOR loop just above the error: you should loop over your saved
fields, not the fields in rel (which there are none).
Yes, there is a 1:M between Relationships and Fields, so you would be
wise to use two tables.

-Tom.

As part of an upgrade routine, I need to delete all relations, drop and
import some tables, then reapply the relationships.

The error I'm getting is:

Error Number 3366: Cannot append a relation with no fields defined.

How do I save, retrieve and apply the fields that belong to each
relationship?

Here's how I save the relations:

Public Function SaveRelations()
Dim db As DAO.Database
Dim rstRel As DAO.Recordset
Dim rstTbl As DAO.Recordset
Dim tdf As DAO.TableDef
Dim rel As DAO.Relation
Dim strTbl As String
Dim strSql As String
Set db = CurrentDb()
Set rstRel = db.OpenRecordset("tblRelations")
strSql = "DELETE * FROM tblRelations;" 'clear previous list
db.Execute strSql, dbFailOnError
db.Relations.Refresh
For Each rel In db.Relations
Debug.Print "Saving Relationship " & rel.Name
With rel
rstRel.AddNew
rstRel!rel = .Name
rstRel!tbl = .Table
rstRel!FrnTbl = .ForeignTable
rstRel!Att = .Attributes
rstRel.Update
End With
Next
End Function

Here's how I apply the relations:

Public Function ApplyRelations()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim rel As DAO.Relation
Dim fld As DAO.Field
Dim strRel As String
Dim strFrnTbl As String
Dim strFld As String
Dim strFrnFld As String
Set db = CurrentDb
Set rst = db.OpenRecordset("tblRelations")
Do While Not rst.EOF
'create relations
Set rel = db.CreateRelation(rst!rel, rst!tbl, _
rst!FrnTbl, rst!Att)
'set field attributes
For Each fld In rel.Fields
strFld = fld.Name
strFrnFld = fld.ForeignName
rel.Fields.Append rel.CreateField(strFld)
rel.Fields(strFld).ForeignName = strFrnFld
Next
db.Relations.Append rel '<<=== error here * * *
Loop
db.Relations.Refresh
End Function

Should I use a second table to store the fields that belong to each
relation? How would I retrieve and apply the field properties in my
ApplyRelations function?

Thanks in advance.

[deko]

> In the FOR loop just above the error: you should loop over your saved

fields, not the fields in rel (which there are none).
Yes, there is a 1:M between Relationships and Fields, so you would be
wise to use two tables.

This seems to do the trick - the foreign fields are always the same name as
the PK

Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim rel As DAO.Relation
Set db = CurrentDb
Set rst = db.OpenRecordset("tblRelations")
Do While Not rst.EOF
Set rel = db.CreateRelation(rst!RelName, rst!RelTbl, _
rst!FrnTbl, rst!RelAtt)
rel.Fields.Append rel.CreateField(rst!RelFld)
rel.Fields(rst!RelFld).ForeignName = rst!RelFld
db.Relations.Append rel
db.Relations.Refresh 'not sure if I need this
rst.MoveNext
Loop

Thanks for the help.