Transferencia entre Excel y Access

Ejemplo para anexar registros de una tabla de Excel a una BD Access:
'NOTA: Marcar referencia (Herramienta -> Referencias...)
'           "Microsoft ActiveX Data Object 2.8 Library"
Sub AnexarTablaExcelA_Access()
    'En caso de error ir a "err"
    On Error GoTo err

    'Definimos las variables a utilizar
    Dim cn As ADODB.Connection          'Objeto de conexión Access
    Dim ConExcel As String              'Cadena de conexión Excel
    Dim sql As String                   'Sentencia SQL
    Dim Origen As String                'Tabla Origen en Excel
    Dim Destino As String               'Tabla Destino en Access
    Dim DirBDAccess As String           'Dirección BD Access
    Dim DirLibroExcel As String         'Dirección Libro Excel

    'Desactivamos las alertas
    Application.DisplayAlerts = False
    
    'Indicamos rutas de la BD Access y Libro de Excel
    DirBDAccess = "D:\Pruebas\Base de Datos Access.accdb"
    DirLibroExcel = "D:\Pruebas\Exportar a Access.xlsx"

    'Definimos el nombre de las tablas:
    Origen = "[DeExcelaAccess$]"
    Destino = "[Presupuesto4]"
    
    'Establecemos conexion con la BD Access
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DirBDAccess & ";"

    'Establacemos conexion con el archivo de Excel, desde donde vamos a exportar la tabla
    ConExcel = "'" & DirLibroExcel & "' 'Excel 8.0;HDR=Yes;'"
    
    'Importamos la tabla de Excel a Access
    sql = "INSERT INTO " & Destino & " SELECT * FROM " & Origen & " IN " & ConExcel 
    cn.Execute sql

    'Cerramos conexión y liberamos memoria
    cn.Close
    
    'Liberamos memoria
    Set cn = Nothing
err:
    'Activamos nuevamente las alertas
    Application.DisplayAlerts = True
End Sub

Ejemplo para exportar una tabla de Excel a una BD Access:
'NOTA: Marcar referencia (Herramienta -> Referencias...)
'           "Microsoft ActiveX Data Object 2.8 Library"
Sub ImportarTablaExcelA_Access()
    'En caso de error ir a "err"
    On Error GoTo err

    'Definimos las variables a utilizar
    Dim cn As ADODB.Connection          'Objeto de conexión Access
    Dim ConExcel As String              'Cadena de conexión Excel
    Dim sql As String                   'Sentencia SQL
    Dim Origen As String                'Tabla Origen en Excel
    Dim Destino As String               'Tabla Destino en Access
    Dim DirBDAccess As String           'Dirección BD Access
    Dim DirLibroExcel As String         'Dirección Libro Excel

    'Desactivamos las alertas
    Application.DisplayAlerts = False
    
    'Indicamos rutas de la BD Access y Libro de Excel
    DirBDAccess = "D:\Pruebas\Base de Datos Access.accdb"
    DirLibroExcel = "D:\Pruebas\Exportar a Access.xlsx"

    'Definimos el nombre de las tablas:
    Origen = "[DeExcelaAccess$]"
    Destino = "[TablaNueva]"
    
    'Establecemos conexion con la BD Access
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DirBDAccess & ";"

    'Eliminamos la tabla en Destino en Access en caso de que exista
    sql = "DROP TABLE " & Destino
    On Error Resume Next
    cn.Execute sql
    
    'Establacemos conexion con el archivo de Excel, desde donde vamos a exportar la tabla
    ConExcel = "'" & DirLibroExcel & "' 'Excel 8.0;HDR=Yes;'"

    'Importamos la tabla de Excel a Access
    sql = "SELECT * INTO " & Destino & " FROM " & Origen & " IN " & ConExcel
    cn.Execute sql
    
    'Cerramos conexión y liberamos memoria
    cn.Close
    Set cn = Nothing
err:
    'Activamos nuevamente las alertas
    Application.DisplayAlerts = True
End Sub

Ejemplo para pegar una consulta SQL  de una BD Access a un libro de Excel:
'NOTA: Marcar referencia (Herramienta -> Referencias...)
'           "Microsoft ActiveX Data Object 2.8 Library"
Sub PegarConsultaSQL_Access()
    'En caso de error ir a "err"
    On Error GoTo err

    'Declaración de variables
    Dim cn As ADODB.Connection  'Objeto de conexión
    Dim rst As ADODB.Recordset  'Objeto de recorset
    Dim sql As String           'Sentencia SQL
    Dim RutaBD As String        'Ruta de la BD Access
    Dim ArchivoBD As String     'Nombre de la BD Access que contiene la tabla
    Dim i As Integer            'Contador
    Dim LibroExcel As Workbook  'Libro Excel destino
    Dim DirLibroExcel As String 'Dirección del libro Excel destino
    
    'Desactivamos las alertas
    Application.DisplayAlerts = False
    
    'Instrucción SQL
    sql = "SELECT * FROM Presupuesto WHERE Evento = 'Sometido I 2017'"

    'Crea un objeto Conexión
    Set cn = CreateObject("ADODB.Connection")
    
    'IMPORTANTE: Indicar la cadena de conexión a usar
    RutaBD = "D:\Pruebas"
    ArchivoBD = "Base de Datos Access.accdb"
    cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
                        RutaBD & "\" & ArchivoBD & ";Persist Security Info=False;"

    'Abre la conexión a la base de datos
    cn.Open

    'Crea un nuevo objeto recordset
    Set rst = CreateObject("ADODB.Recordset")

    'Ejecuta la sentencia SQL para llenar el recordset
    rst.Open sql, cn
    
    'Indicamos la ubicación del Libro 2
    DirLibroExcel = "D:\Pruebas\Libro Excel Destino.xlsx"

    'Abrimos el Libro 2
    Set LibroExcel = Workbooks.Open(DirLibroExcel)
    
    'Pegamos el resultado de la consulta SQL
    LibroExcel.Sheets("De Access a Excel").Range("A2").CopyFromRecordset rst
    
    'Cerramos el Libro 2 guardando los cambios
    LibroExcel.Close True
    
    'Cierra y descarga las referencias
    On Error Resume Next

    'Libera memoria
    rst.Close
    cn.Close

    'Liberamos memoria
    Set rst = Nothing
    Set cn = Nothing
    Set LibroExcel = Nothing
err:
    'Activamos nuevamente las alertas
    Application.DisplayAlerts = True
End Sub

No hay comentarios:

Publicar un comentario