'Sacado de la Ayuda de Access
'En una MDB con tablas ya existentes, como crear 
'Relaciones entre las Tablas ya existentes de Datos.Mdb

Option Compare Database
Option Explicit

Function CreateRelationX()

    Dim dbsNeptuno As Database
    Dim tdfEmpleados As TableDef
    Dim tdfNuevo As TableDef
    Dim idxNuevo As Index
    Dim relNuevo As Relation
    Dim idxBucle As Index

    Set dbsNeptuno = OpenDatabase("c:\Carpeta\Neptuno.mdb")

    With dbsNeptuno
        ' Agrega un campo nuevo a la tabla Empleados.
        Set tdfEmpleados = .TableDefs!Empleados
        tdfEmpleados.Fields.Append _
            tdfEmpleados.CreateField("IdDpto", dbInteger, 2)

        ' Crea la tabla Departmentos nueva.
        Set tdfNuevo = .CreateTableDef("Departmentos")

        With tdfNuevo
            ' Crea y agrega los objetos Field a la
            ' colección Fields del objeto TableDef nuevo.
            .Fields.Append .CreateField("IdDpto", dbInteger, 2)
            .Fields.Append .CreateField("NombreDpto", dbText, 20)

            ' Crea el objeto Index en la tabla Departamentos.
            Set idxNuevo = .CreateIndex("ÍndiceIdDpto")
            ' Crea y agrega el objeto Field a la
            ' colección Fields del objeto Index nuevo.
            idxNuevo.Fields.Append idxNuevo.CreateField("IdDpto")
            ' El índice en la tabla principal debe ser
            ' Unique para formar parte de un Relation.
            idxNuevo.Unique = True
            .Indexes.Append idxNuevo
        End With

        .TableDefs.Append tdfNuevo

        ' Crea el objeto Relation EmpleadosDepartamentos, utilizando los nombres
        ' de las dos tablas en la relación.
        Set relNuevo = .CreateRelation("EmpleadosDepartamentos", _
            tdfNuevo.Name, tdfEmpleados.Name, _
            dbRelationUpdateCascade)

        ' Crea el objeto Field para la colección Fields
        ' del objeto Relation nuevo. Establece las
        ' propiedades Name y ForeignName basadas en los
        ' campos que se van a utilizar en la relación.
        relNuevo.Fields.Append relNuevo.CreateField("IdDpto")
        relNuevo.Fields!IdDpto.ForeignName = "IdDpto"
        .Relations.Append relNuevo

        ' Imprime un informe.
        Debug.Print "Properties de" & relNuevo.Name & _
            " Relation"
        Debug.Print "  Tabla = " & relNuevo.Table
        Debug.Print "  TablaExterna = " & _
            relNuevo.ForeignTable
        Debug.Print "Fields de " & relNuevo.Name & " Relation"

        With relNuevo.Fields!IdDpto
            Debug.Print "  " & .Name
            Debug.Print "    Nombre = " & .Name
            Debug.Print "    TablaExterna = " & .ForeignName
        End With

        Debug.Print "Indexes en " & tdfEmpleados.Name & _
            " TableDef"
        For Each idxBucle In tdfEmpleados.Indexes
            Debug.Print "  " & idxBucle.Name & _
                ", Foreign = " & idxBucle.Foreign
        Next idxBucle

        ' Elimina los objetos nuevos porque estos es un ejemplo.
        .Relations.Delete relNuevo.Name
        .TableDefs.Delete tdfNuevo.Name
        tdfEmpleados.Fields.Delete "IdDpto"
        .Close
    End With

End Function

    Source: geocities.com/es/ensolva/Descargas/Documentos

               ( geocities.com/es/ensolva/Descargas)                   ( geocities.com/es/ensolva)                   ( geocities.com/es)