ACC97: Sample DAO Code to Create a Many-to-Many Relationship

MORE INFORMATION

Microsoft provides programming examples for illustration only, without warranty either expressed or implied. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. Microsoft support engineers 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 requirements. The 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:

1. Create a new Microsoft Access 97 database.
2. Create a new form in Design view, and add a command button to the form. Do not use the Command Button Wizard to add the command button.
3. On the View menu, click Code.
4. Type the following lines in the Declarations section if they are not already there:

   Option Compare Database
   Option Explicit
   					

5. Type or paste the following code into the module:

         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
   					

6. Save the form. Open the form in Form View and click the command button. Note the additional information in the message box that is displayed when you click the command button.