VB6 - Create Relationship in Access Using DAO/Access Object Model

[RobDog888]

I didnt see anything on creating an Access Relationship when
I searched, so here is my code to create a relationship.

It also creates a new blank Access database, Add 2 new tables,
creates new fields, set primary keys, and then its creates a
relationship between the two tables based on the primary keys.

Works on Access versions 2000 +.
I don't have Access 97 anymore so un-tested on 97.

Option Explicit
'Add reference to MS Access xx.0 Object Library
'Add reference to DAO 3.x Object Library
Private oApp As Access.Application
 
Private Sub Form_Load()
    
    Dim oRel As DAO.Relation
    Dim oDB As DAO.Database
    Dim oTable1 As DAO.TableDef
    Dim oTable2 As DAO.TableDef
    Dim oIndex As DAO.Index
    
    'Create new blank access database
    Set oApp = New Access.Application
    oApp.NewCurrentDatabase App.Path & "\MyDB2.mdb"
    Set oDB = oApp.CurrentDb
    oApp.Visible = True
    
    'Create first table (Table1)
    Set oTable1 = oDB.CreateTableDef("Table1")
    With oTable1
        .Fields.Append .CreateField("Field1", dbInteger)
        .Fields.Append .CreateField("Field2", dbText)
        .Fields.Append .CreateField("Field3", dbText)
        .Fields.Append .CreateField("Field4", dbText)
    End With
    oDB.TableDefs.Append oTable1
    
    'Create an index on Table1
    Set oIndex = oTable1.CreateIndex
    With oIndex
        .Name = "Field1Index"
        .Fields.Append .CreateField("Field1")
        .Primary = True
    End With
    oTable1.Indexes.Append oIndex
    
    'Create second table (Table2)
    Set oTable2 = oDB.CreateTableDef("Table2")
    With oTable2
        .Fields.Append .CreateField("Field1", dbInteger)
        .Fields.Append .CreateField("Field2", dbText)
        .Fields.Append .CreateField("Field3", dbText)
        .Fields.Append .CreateField("Field4", dbText)
    End With
    oDB.TableDefs.Append oTable2
    
    'Create an index on Table2
    Set oIndex = Nothing
    Set oIndex = oTable2.CreateIndex
    With oIndex
        .Name = "Field1Index"
        .Fields.Append .CreateField("Field1")
        .Primary = True
    End With
    oTable2.Indexes.Append oIndex
    
    'Create relationship between table1 and table2
    Set oRel = oApp.CurrentDb.CreateRelation("MyRelationship", "Table1", "Table2", dbRelationLeft Or dbRelationUpdateCascade Or dbRelationDeleteCascade)
    oRel.Fields.Append oRel.CreateField("Field1")
    oRel.Fields("Field1").ForeignName = "Field1"
    oApp.CurrentDb.Relations.Append oRel
 
    MsgBox "Done!"
    Unload Me
    
End Sub