Option Compare Database
Option Explicit
'Referencia la ADOX=Microsoft Ado Ext 2.X dor DDL an Security

Private Sub CreaTablaLejana()
 On Error GoTo ErrorCreateDB
 Dim Cat As New ADOX.Catalog
 Dim ObjetoTabla As ADOX.Table
 Dim sCnn    As String
 Dim RutaDestino As String
 'Miguel Angel, aqui pon la ruta de la mdb de datos en la que quieras
 'crear la tabla:
 RutaDestino = CurrentProject.Path & "\pruebas.mdb"
sCnn = _
 "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Engine Type=5;Data Source=" & RutaDestino
Cat.ActiveConnection = sCnn
  Set ObjetoTabla = New ADOX.Table

  ObjetoTabla.ParentCatalog = Cat

  With ObjetoTabla

    .Name = "TablaCaton"  'pon aqui el nombre que qeieras dar a la tabla.

    .Columns.Append "fldauto", 3
      .Columns("fldauto").Properties("Nullable").Value = False
      .Columns("fldauto").Properties("Default").Value = 0
      .Columns("fldauto").Properties( _
          "Jet OLEDB:Compressed UNICODE Strings").Value = False
    .Columns.Append "fldboolean", 11
      .Columns("fldboolean").Properties("Nullable").Value = False
      .Columns("fldboolean").Properties( _
          "Jet OLEDB:Compressed UNICODE Strings").Value = False
    .Columns.Append "fldbyte", 17
      .Columns("fldbyte").Properties("Nullable").Value = False
      .Columns("fldbyte").Properties("Default").Value = 0
      .Columns("fldbyte").Properties( _
          "Jet OLEDB:Compressed UNICODE Strings").Value = False
    .Columns.Append "fldcurrency", 6
      .Columns("fldcurrency").Properties("Nullable").Value = False
      .Columns("fldcurrency").Properties("Default").Value = 0
      .Columns("fldcurrency").Properties( _
          "Jet OLEDB:Compressed UNICODE Strings").Value = False
    .Columns.Append "flddate", 7
      .Columns("flddate").Properties("Nullable").Value = False
      .Columns("flddate").Properties( _
          "Jet OLEDB:Compressed UNICODE Strings").Value = False
    .Columns.Append "flddouble", 5
      .Columns("flddouble").Properties("Nullable").Value = False
      .Columns("flddouble").Properties("Default").Value = 0
      .Columns("flddouble").Properties( _
          "Jet OLEDB:Compressed UNICODE Strings").Value = False
    .Columns.Append "fldhyper", 203
      .Columns("fldhyper").Properties("Nullable").Value = False
      .Columns("fldhyper").Properties( _
          "Jet OLEDB:Compressed UNICODE Strings").Value = False
      .Columns("fldhyper").Properties( _
          "Jet OLEDB:Allow Zero Length").Value = True
    .Columns.Append "fldinteger", 2
      .Columns("fldinteger").Properties("Nullable").Value = False
      .Columns("fldinteger").Properties("Default").Value = 0
      .Columns("fldinteger").Properties( _
          "Jet OLEDB:Compressed UNICODE Strings").Value = False
    .Columns.Append "fldlong", 3
      .Columns("fldlong").Properties("Nullable").Value = False
      .Columns("fldlong").Properties("Default").Value = 0
      .Columns("fldlong").Properties( _
          "Jet OLEDB:Compressed UNICODE Strings").Value = False
    .Columns.Append "fldmemo", 203
      .Columns("fldmemo").Properties("Nullable").Value = False
      .Columns("fldmemo").Properties( _
          "Jet OLEDB:Compressed UNICODE Strings").Value = False
      .Columns("fldmemo").Properties( _
          "Jet OLEDB:Allow Zero Length").Value = True
    .Columns.Append "fldole", 205
      .Columns("fldole").Properties("Nullable").Value = False
      .Columns("fldole").Properties( _
          "Jet OLEDB:Compressed UNICODE Strings").Value = False
      .Columns("fldole").Properties( _
          "Jet OLEDB:Allow Zero Length").Value = True
    .Columns.Append "fldsingle", 4
      .Columns("fldsingle").Properties("Nullable").Value = False
      .Columns("fldsingle").Properties("Default").Value = 0
      .Columns("fldsingle").Properties( _
          "Jet OLEDB:Compressed UNICODE Strings").Value = False
    .Columns.Append "fldtext", 202, 50
      .Columns("fldtext").Properties("Nullable").Value = False
      .Columns("fldtext").Properties( _
          "Jet OLEDB:Allow Zero Length").Value = True
  End With

  Cat.Tables.Append ObjetoTabla


  Set Cat = Nothing

ErrorCreateDB:
    MsgBox "Error Numero: " & Err.Number & "-> " & Err.Description, vbCritical, "ERROR"

End Sub