ACC97: Sample DAO Code to Create a Many-to-Many RelationshipID: Q193165
|
Advanced: Requires expert coding, interoperability, and multi-user skills.
If you want to set up a many-to-many relationship between two tables, you
need to set up a third table called a junction (or cross-reference) table,
and then establish two, one-to-many relationships, one between each of the
original tables and the junction table.
This article shows you how to create each of these three tables and how
to establish the relationships between them by using Data Access Objects
(DAO) in Visual Basic for Applications code.
Microsoft provides programming examples for illustration only, without warranty
either expressed or implied, including, but not limited to, the implied warranties of
merchantability and/or fitness for a particular purpose. This article assumes that you
are familiar with the programming language being demonstrated and the tools used to
create and debug procedures. Microsoft support professionals can help explain the functionality
of a particular procedure, but they will not modify these examples to provide added
functionality or construct procedures to meet your specific needs. If you have limited
programming experience, you may want to contact a Microsoft Certified Solution Provider
or the Microsoft fee-based consulting line at (800) 936-5200. For more information about
Microsoft Certified Solution Providers, please see the following page on the World Wide Web:
http://www.microsoft.com/mcsp/For more information about the support options available from Microsoft, please see the following page on the World Wide Web:
http://www.microsoft.com/support/supportnet/overview/overview.aspThe following code will create three tables and the appropriate one-to-many relationships necessary to create the effect of a many-to-many relationship. In addition, it creates a query with all the necessary fields in it, so that you can build a form on it for data entry purposes. To create a many-to-many relationship, follow these steps:
Option Compare Database
Option Explicit
Private Sub Command0_Click()
CreateManyToMany
End Sub
Sub CreateManyToMany()
Dim MyRelation As Relation
Dim Result As Integer
Dim QDF As QueryDef
'Delete all objects if they previously existed.
CheckTables
'Create Junction table.
CurrentDb.Execute "Create Table Junctiontable" _
& "(TableA_ID integer, TableB_ID integer);"
CurrentDb.Execute "CREATE INDEX MyIndex ON JunctionTable" _
& "(TableA_ID Asc)"
CurrentDb.Execute "CREATE INDEX MyIndex1 ON JunctionTable" _
& "(TableB_ID Asc)"
'Create TableA.
CurrentDb.Execute "Create Table TableA (ID Counter Constraint " _
& "ID PRIMARY KEY, FName Text, LName text, address text);"
'Create TableB.
CurrentDb.Execute "Create Table TableB (ID Counter Constraint " _
& "ID PRIMARY KEY, FName Text, LName text, address text);"
'Create Relationship.
Result = NewRelation("TableA", "TableA_ID", "MyRelation1")
Result = NewRelation("TableB", "TableB_ID", "MyRelation2")
MsgBox ("Three tables were created. TableA, TableB and " _
& "JunctionTable. Two One-To-Many Relationships were also " _
& "created between these tables to give the effect of a " _
& "Many-To-Many relationship. To see this, close this form, " _
& "in the Tools menu click Relationships and choose Show All.")
'Create query.
Set QDF = CurrentDb.CreateQueryDef("ShowManyToManyRecords", _
"SELECT TableB.ID, TableB.FName, TableB.LName, TableB.address, " _
& "TableA.ID, TableA.FName, TableA.LName, TableA.address, " _
& "* FROM TableB INNER JOIN (TableA INNER JOIN Junctiontable " _
& "ON TableA.ID = Junctiontable.TableA_ID) ON TableB.ID = " _
& "Junctiontable.TableB_ID;")
'CurrentDb.QueryDefs.Append QDF
End Sub
Function NewRelation(TableName, ForeignKey, RelationName)
Dim MyDB As Database
Dim MyField As Field
Dim MyRelation As Relation
Set MyDB = CurrentDb
Set MyRelation = MyDB.CreateRelation(RelationName, TableName, _
"JunctionTable", dbRelationDeleteCascade + _
dbRelationUpdateCascade)
'Create field in Fields collection of Relation object.
Set MyField = MyRelation.CreateField("ID")
'Provide name of foreign key field.
MyField.ForeignName = ForeignKey
'Append field to Relation object and Relation object to database.
MyRelation.Fields.Append MyField
'Append relation to relationship's collection
MyDB.Relations.Append MyRelation
Set MyDB = Nothing
End Function
Private Sub CheckTables()
'If these tables already exist, then delete them before proceeding
'to recreate them again.
Dim MyDB As Database
Dim X As Integer
Set MyDB = CurrentDb()
'If these relationships already exist, then delete them before
'proceeding to recreate them again.
If MyDB.Relations.Count > 0 Then
For X = 0 To MyDB.Relations.Count - 1
MyDB.Relations.Delete MyDB.Relations(0).Name
Next
End If
For X = 0 To MyDB.TableDefs.Count - 1
If MyDB.TableDefs(X).Name = "JunctionTable" Or _
MyDB.TableDefs(X).Name = "TableA" Or _
MyDB.TableDefs(X).Name = "TableB" Then
DoCmd.DeleteObject acTable, MyDB.TableDefs(X).Name
End If
Next
'If these queries already exist, then delete them before proceeding
'to recreate them again.
For X = 0 To MyDB.QueryDefs.Count - 1
If MyDB.QueryDefs(X).Name = "ShowManyToManyRecords" Then
DoCmd.DeleteObject acQuery, MyDB.QueryDefs(X).Name
End If
Next
End Sub
Private Sub Form_Load()
Command0.Caption = "Create Tables and Relationships"
Command0.Height = 1440
Command0.Width = 1440 * 3
End Sub
Additional query words: vba inf
Keywords : kbdta AccCon MdlDao RltOthr
Version : WINDOWS:97
Platform : WINDOWS
Issue type : kbhowto
Last Reviewed: July 6, 1999