Access - Crear relaciones codificando

Sub CrearRelacion()

    Dim db As Database

    Dim rel As Relation

    Dim tdf1 As TableDef

    Dim tdf2 As TableDef

    ' Establecer una referencia a la base de datos actual

    Set db = CurrentDb

    ' Obtener las tablas que deseas relacionar

    Set tdf1 = db.TableDefs("Tabla1")

    Set tdf2 = db.TableDefs("Tabla2")

    ' Crear una nueva relación

    Set rel = db.CreateRelation("Relacion1")

    ' Establecer las propiedades de la relación

    With rel

        .Table = tdf1.Name

        .ForeignTable = tdf2.Name

        .Fields.Append .CreateField("Campo1", dbLong)

        .Fields("Campo1").ForeignName = "CampoRelacionado"

    End With

    ' Añadir la relación a la colección de relaciones de la base de datos

    db.Relations.Append rel

    ' Guardar los cambios realizados

    db.Close

    Set rel = Nothing

    Set tdf2 = Nothing

    Set tdf1 = Nothing

    Set db = Nothing

    MsgBox "La relación se ha creado correctamente.", vbInformation

End Sub