'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
'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