Agregar datos a una nueva tabla de una base de datos de Access               

En este ejemplo se agrega una nueva tabla a la base de datos neptuno.mdb. A continuación, la subrutina rellena la tabla con los datos que se encuentran en las celdas S1:V30 de esta hoja de cálculo. Para ello es necesario que el archivo neptuno.mdb esté in               
               
               
               
               
Sub CreateTable()               
''' NOTA: Para utilizar esta subrutina, es necesario crear               
'''       una referencia a la versión más reciente               
'''       de la siguiente biblioteca:               
''               
''        Biblioteca de objetos de datos ActiveX de Microsoft               
''        Ext. Microsoft ADO 2.1 para DDL y seguridad               
                
    ' Las primeras cuatro líneas Dim simultáneamente declaran y               
    ' crean nuevos objetos. Puede utilizar esta sintaxis o bien               
    ' utilizar la declaración Set para crear los objetos.               
    Dim cat As New ADOX.Catalog               
    Dim tbl As New ADOX.Table
    Dim conn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
   
    Dim looprange As Range
    Dim currcell As Range
   
    With conn
        ' Establece el proveedor OleDB para la conexión.
        .Provider = "Microsoft.JET.OLEDB.4.0"
        ' Abre una conexión a Neptuno.mdb.
        .Open Application.Path & "\samples\neptuno.mdb"
    End With
       
    ' Establece la conexión activa para el objeto Catalog.
    cat.ActiveConnection = conn
   
    With tbl
        ' Asigna un nombre a la nueva tabla.
        .Name = "Tabla_de_ventas"
        ' Asigna un nombre a las columnas de la nueva tabla.
        With .Columns
            .Append "Nombre"
            .Append "Región"
            .Append "Producto"
            ' La columna Sales debe ser de tipo de datos "Moneda".
            .Append "Ventas", adCurrency
        End With
    End With
   
    ' Agrega la tabla a la base de datos.
    cat.Tables.Append tbl
   
    With rst
        .ActiveConnection = conn
        ' Abre la nueva tabla. El argumento LockType del método
        ' Open debe establecerse a adLockOptimistic a fin de
        ' agregar registros a la tabla.
        .Open "Tabla_de_ventas", LockType:=adLockOptimistic
    End With
   
    ' Establece el rango de la hoja activa que contiene
    ' los registros que se añadirán a la base de datos.
    Set looprange = Range("s2", Range("s2").End(xlDown))

    ' Examina la información de la hoja de cálculo.
    For Each currcell In looprange
        With rst
            ' Agrega un nuevo registro.
            .AddNew
            ' Agrega información a los campos correspondientes.
            .Fields("Nombre").Value = currcell.Value
            .Fields("Región").Value = currcell.Offset(0, 1).Value
            .Fields("Producto").Value = currcell.Offset(0, 2).Value
            .Fields("Ventas").Value = currcell.Offset(0, 3).Value
            ' Escribe el nuevo registro a la base de datos.
            .Update
        End With
    Next currcell
   
    rst.Close
    Set tbl = Nothing
    Set cat = Nothing
    conn.Close
End Sub