'Funcion que utilizando ADO crea una tabla, campos e índices
'La funcion devuelve un valor Booleano y es necesario introducir la cadena
'que indique la ruta de la base.
'***************************************************************************
'Crea la tabla ...
Public Function CrearTbl(Ruta As String) As Boolean  'Ruta es  la ubicación de la BD sin su nombre...


  On Error GoTo PROC_ERR

  Dim cnn As New ADODB.Connection
  Dim objTbl As New Table
  Dim objCat As New ADOX.Catalog
  Dim objKey As New ADOX.Key
  Dim strConnection As String

  strConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                  "Data Source=" & Ruta & "BD.mdb;" _
    & "Jet OLEDB:Database Password =1111111111;"

  cnn.Open strConnection

  Set objCat.ActiveConnection = cnn 'Cnn a la tabla...

  
  objTbl.Name = "NombreTabla"
  objTbl.Columns.Append "Campo1", adVarWChar
  objTbl.Columns("Campo1").Attributes = adColNullable    'Permite ingresar valores nulos...
  objTbl.Columns("Description").Attributes = adColNullable
  objCat.Tables.Append objTbl 'Añado de forma efectiva la tabla

  'Creo una clave primaria
  objKey.Name = "Campo1"
  objKey.Type = adKeyPrimary
  objKey.Columns.Append "Campo1"

  objTbl.Keys.Append objKey

  CrearTbl= True     'Si no hay errores retorna TRUE

  cnn.Close
  Set objKey = Nothing
  Set objTbl = Nothing
  Set objCat = Nothing
  Set cnn = Nothing

PROC_EXIT:
  On Error Resume Next
  'Limpia los objetos de memoria...
  Set objKey = Nothing
  Set objTbl = Nothing
  Set objCat = Nothing
  Set cnn = Nothing
  Exit Function

PROC_ERR:

  CrearTblListas = False
  Resume PROC_EXIT

End Function

'**********************************************************************
'**********************************************************************
'Otro ejemplo, este mas sencillo.
'Agregar un campo Autonumerico a una tabla ya existente (Y otros campos más)

Sub CreateAutoIncrColumn()

        Dim cat     As New ADOX.Catalog
        Dim tbl     As New ADOX.Table
        Dim col     As New ADOX.Column

    ' Abre el catálogo
    cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=C:\MiRuta\MiBase.mdb;"

    With tbl
        .Name = "Clientes"
        Set .ParentCatalog = cat
        ' Crea los campos y los anexa 
        .Columns.Append "ClienteId", adInteger
        ' Convierte la columna ContactId en una columna de incremento automático
        .Columns("ClienteId").Properties("AutoIncrement") = True
        .Columns.Append "Cuenta", adVarWChar
        .Columns.Append "Nombre", adVarWChar
        .Columns.Append "Apellidos", adVarWChar
        .Columns.Append "Telefono", adVarWChar, 20
        .Columns.Append "Observaciones", adLongVarWChar
    End With

    cat.Tables.Append tbl

    Set cat = Nothing

End Sub

'**********************************************************************