A
alexrs2k
I have this code to automatically create relations in a db with link tables
when the Field names are the same for different tables from SQL ODBC
conection but when it gets to "db.Relations.Append rel" gives an error:
"Can't create the relation in a link table". Any I deas? Thank you.
Sub CreateRelations()
Dim db As Database
Dim tb As TableDef, tb1 As TableDef
Dim rs As Recordset
Dim rel As Relation
Dim fld As Field, fld1 As Field
Dim sFieldName As String
Set db = CurrentDb()
For Each tb In db.TableDefs
For Each fld In tb.Fields
For Each tb1 In db.TableDefs
If tb.Name <> tb1.Name Then
For Each fld1 In tb1.Fields
If fld.Name = fld1.Name Then
Set rel = db.CreateRelation(tb.Name & tb1.Name,
tb.Name, tb1.Name, dbRelationInherited)
rel.Fields.Append rel.CreateField(fld.Name)
sFieldName = fld.Name
rel.Fields(sFieldName).ForeignName = fld.Name
db.Relations.Append rel
End If
Next 'fld1
End If
Next 'tb1
Next 'fld
Next 'tb
End Sub
when the Field names are the same for different tables from SQL ODBC
conection but when it gets to "db.Relations.Append rel" gives an error:
"Can't create the relation in a link table". Any I deas? Thank you.
Sub CreateRelations()
Dim db As Database
Dim tb As TableDef, tb1 As TableDef
Dim rs As Recordset
Dim rel As Relation
Dim fld As Field, fld1 As Field
Dim sFieldName As String
Set db = CurrentDb()
For Each tb In db.TableDefs
For Each fld In tb.Fields
For Each tb1 In db.TableDefs
If tb.Name <> tb1.Name Then
For Each fld1 In tb1.Fields
If fld.Name = fld1.Name Then
Set rel = db.CreateRelation(tb.Name & tb1.Name,
tb.Name, tb1.Name, dbRelationInherited)
rel.Fields.Append rel.CreateField(fld.Name)
sFieldName = fld.Name
rel.Fields(sFieldName).ForeignName = fld.Name
db.Relations.Append rel
End If
Next 'fld1
End If
Next 'tb1
Next 'fld
Next 'tb
End Sub