Programmatically create/undo relationships 1

[brainmetz]

How do i write a macro that would create/undo relationships between tables? For instance if I have table1 and table2 both with phone number as a feild.

I know how to manually do this and it works but I wanted to write a macro to do this.

Thanks,

Shane

 

[brainmetz]

Or I could just use a module...But I dont know where to start.

Thanks,

Shane

 

[BillPower]

Hi Shane,
The following examples will create a one to many relationship between two Fields named Telephone in Table1 and Telephone in Table2, then delete it.

Create an Index on the Telephone Field in Table1, then create a realtionship:

Sub Create_Relationship()
Dim dbs As Database
Dim tdfTable1 As TableDef
Dim tdfTable2 As TableDef
Dim idx As Index
Dim rel As Relation

Set dbs = CurrentDb
With dbs
Set tdfTable1 = .TableDefs!Table1
Set tdfTable2 = .TableDefs!Table2
With tdfTable1
Set idx = .CreateIndex("TelephoneIndex&quot
idx.Fields.Append idx.CreateField("Telephone&quot
idx.Unique = True
.Indexes.Append idx
End With

Set rel = .CreateRelation("TelephoneRelationship", _
tdfTable1.Name, tdfTable2.Name, _
dbRelationUpdateCascade)
rel.Fields.Append rel.CreateField("Telephone&quot
rel.Fields!Telephone.ForeignName = "Telephone"
.Relations.Append rel
.Close
End With
End Sub

Delete the Relationship and then the Index:

Sub Delete_Relationship()
Dim dbs As Database
Dim tdfTable1 As TableDef

Set dbs = CurrentDb
With dbs
.Relations.Delete "TelephoneRelationship"
Set tdfTable1 = .TableDefs!Table1
tdfTable1.Indexes.Delete "TelephoneIndex"
.Close
End With
End Sub

I have also demonstrated how to Enforce Referential Integrity (dbRelationUpdateCascade), for other relationship options look in the ADO Library in the Object Browser.

For further help on this do a search for CreateRelation in Access Help.

Let me know if there is anything you don't understand.

 

[Craig0201]

Even better, use the SQL to do this.

Craig

 

[brainmetz]

I must be missing something...Here is what I have, this is to create the relationship...I do not need an index, becuase i only need an intermediate relationship.


Sub Create_Relationship()
Dim dbs As Database
Dim tdfTable1 As TableDef
Dim tdfTable2 As TableDef
Dim rel As Relation

Set dbs = CurrentDb
With dbs
Set tdfTable1 = .TableDefs!Activity_File
Set tdfTable2 = .TableDefs!Logon_Names
Set rel = .CreateRelation("ComputerLogons", _
tdfTable1.Name, tdfTable2.Name, _
dbRelationUpdateCascade)
.Relations.Append rel
.Close
End With
End Sub

 

[brainmetz]

BTW I put this in a module is that correct?

Thanks Alot.

Shane

 

[BillPower]

You've forgotten the Fields to be used in the Relationship:

rel.Fields.Append rel.CreateField("YourField1&quot
rel.Fields!Telephone.ForeignName = "YourField2"
.Relations.Append rel
.Close

If your Field doesn't have a Unique Index, change dbRelationUpdateCascade to dbRelationDontEnforce.

 

[brainmetz]

Here is the code I have in a Module...Is that correct?


Sub Create_Relationship()
Dim dbs As Database
Dim tdfTable1 As TableDef
Dim tdfTable2 As TableDef
Dim rel As Relation

Set dbs = CurrentDb
With dbs
Set tdfTable1 = .TableDefs!Activity_File
Set tdfTable2 = .TableDefs!Logon_Names

rel.Fields.Append rel.CreateField("Computer Name&quot
rel.Fields!Logon_Names.ForeignName = "Computer Name"
.Relations.Append rel
.Close

Set rel = .CreateRelation("ComputerLogons", _
tdfTable1.Name, tdfTable2.Name, _
dbRelationDontEnforce)
.Relations.Append rel
.Close
End With
End Sub

When I try to run the code I receive:
Compile Error
User-define type not defined.

It points to:
Dim dbs As Database

Any help would greatly be appriciated.

Thank you for everything.

Shane

 

[BillPower]

You need to install a Reference, While in the Visual Basic Editor, from the Menu select Tools-> References, scroll down until you see Microsoft DAO 3.x Library, Tick/Check the Highest Version No. That should do it. Let me know if it doesn't.

Good Luck.

 

[brainmetz]

I now recieve an error that says:

Run-time error 3265
Item not found in this collection.

It errors out at:

Set tdfTable2 = .TableDefs!Logon_Names


BTW...Thanks for all of your help...I am very ignorant when it comes to this stuff...I am good with C++ and regular VB but not the database aspect of it.

Shane

 

[BillPower]

All I can think of is that you might have misspelt Logon_Names or the Table Logon_Names doesn't exist.

 

[brainmetz]

You were correct...I called it Computer_Logons instead of Logon_Names...Dummy Me...

Also, now i am getting run-time error 91

object variable or With block variable not set.

I will try to figure it out.

Thanks alot.

Shane

 

[BillPower]

Hi Shane, Try this:

Dim dbs As Database
Dim tdfTable1 As TableDef
Dim tdfTable2 As TableDef
Dim rel As Relation
Set dbs = CurrentDb
With dbs
Set tdfTable1 = .TableDefs!Activity_File
Set tdfTable2 = .TableDefs!Logon_Names

Set rel = .CreateRelation("ComputerLogons", _
tdfTable1.Name, tdfTable2.Name, _
dbRelationDontEnforce)

rel.Fields.Append rel.CreateField("Computer Name&quot
rel.Fields![Computer Name].ForeignName = "Computer Name"
.Relations.Append rel
.Close
End With

To Delete the Relationship:

Dim dbs As Database
Dim tdfTable1 As TableDef
Set dbs = CurrentDb
With dbs
.Relations.Delete "ComputerLogons"
.Close
End With

Make sure the Tables are spelt correctly (Activity_File and Logon_Names) and that Computer Name is a Field spelt the same and Formatted the same in both Tables.

Can get a bit confusing at times.

 

[brainmetz]

Here is the code I currently have to go with the above post:

Sub Create_Relationship()
Dim dbs As Database
Dim tdfTable1 As TableDef
Dim tdfTable2 As TableDef
Dim rel As Relation

Set dbs = CurrentDb
With dbs
Set tdfTable1 = .TableDefs!Activity_File
Set tdfTable2 = .TableDefs!Computer_Logons

rel.Fields.Append rel.CreateField("Computer Name&quot
rel.Fields!Computer_Logons.ForeignName = "Computer Name"
.Relations.Append rel
.Close

Set rel = .CreateRelation("ComputerLogons", _
tdfTable1.Name, tdfTable2.Name, _
dbRelationDontEnforce)
' .Relations.Append rel
.Close
End With
End Sub

~shane

 

[brainmetz]

Disregard my post from before....That works great...Thanks alot I owe you one...

I wish there were more people like you, who would help out people like me.



Two thumbs up!!!

Shane