Sección de códigos , trucos y ejemplos para visual basic

264 - ( Ado ) Pasar datos de Excel a Access

Ejemplo para recorrer las filas y columnas de una hoja de Excel y pasar los datos a una tabla de Access usando ADO

En el ejemplo se recorren las filas y las columnas de la hoja de Excel que le debemos indicar a la rutina " Excel_a_Access "

Luego cada dato de la celda que se va leyendo en el bucle se añade a la tabla. ( La tabla no puede tener menos campos que las columnas de la hoja de Excel )

También especificar, en la Sub " Excel_a_Access ", el path de la base de datos, el nombre del libro, y el nombre de la tabla , por ejemlpo:

Call Excel_Access (La_Bd, El_libro, La_Tabla, Cantidad_Filas, cantidad_Columnas )

Controles

Añadir un Command1
la referencia de ADO ( Microsoft Activex Data Objects )

Código fuente en el formulario:

Option Explicit 'Agregar la referencia de ADO '---------------------------------------------------- Private Sub Excel_a_Access(Path_BD As String, _ Path_XLS As String, _ La_Tabla As String, _ Filas As Integer, _ Columnas As Integer) Dim Obj_Excel As Object Dim Obj_Hoja As Object Dim cn_Ado As ADODB.Connection Dim rst_Ado As ADODB.Recordset Dim Fila_Actual As Integer Dim Columna_Actual As Integer Dim Dato As Variant Screen.MousePointer = vbHourglass 'Nueva instancia de Excel Set Obj_Excel = CreateObject("Excel.Application") ' Abre el libro de Excel Obj_Excel.Workbooks.Open FileName:=Path_XLS ' si es la versión de Excel 97, asigna la hoja activa ( ActiveSheet ) If Val(Obj_Excel.Application.Version) >= 8 Then Set Obj_Hoja = Obj_Excel.ActiveSheet Else Set Obj_Hoja = Obj_Excel End If 'Abre una nueva conexión Ado Set cn_Ado = New ADODB.Connection ' Cadena de conexión cn_Ado.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & Path_BD & ";" & _ "Persist Security Info=False" ' Abre la base de datos cn_Ado.Open 'Nuevo objeto recordset Set rst_Ado = New ADODB.Recordset 'Abre el recordset rst_Ado.Open "Select * FROM " & La_Tabla, _ cn_Ado, adOpenStatic, adLockPessimistic 'Se posiciona al final If rst_Ado.RecordCount <> 0 Then rst_Ado.MoveLast ' Recorre las filas y columnas de la hoja For Fila_Actual = 1 To Filas 'Nuevo registro rst_Ado.AddNew For Columna_Actual = 0 To Columnas - 1 ' Va leyendo los datos de la celda indicada Dato = Trim$(Obj_Hoja.Cells(Fila_Actual, Columna_Actual + 1)) 'Agrega los datos al campo indicado rst_Ado(Columna_Actual).Value = Dato Next Next Call Descargar_Objetos(rst_Ado, cn_Ado, Obj_Excel, Obj_Hoja) Screen.MousePointer = vbDefault MsgBox " Datos copiados ", vbInformation Exit Sub 'Error ErrSub: Call Descargar_Objetos(rst_Ado, cn_Ado, Obj_Excel, Obj_Hoja) MsgBox Err.Description, vbCritical Screen.MousePointer = vbDefault End Sub 'Descarga los objetos y los cierra Sub Descargar_Objetos(rst_Ado As ADODB.Recordset, cn_Ado As ADODB.Connection, _ Obj_Excel As Object, Obj_Hoja As Object) Set rst_Ado = Nothing cn_Ado.Close Set cn_Ado = Nothing Obj_Excel.ActiveWorkbook.Close False Obj_Excel.Quit Set Obj_Hoja = Nothing Set Obj_Excel = Nothing End Sub Private Sub Command1_Click() ' Pasar como parámetro el nombre y path de la _ base de datos y del libro excel, el nombre de la tabla _ y la cantidad de filas y columnas de la hoja a leer Call Excel_a_Access(App.Path & "\bd1.mdb", _ App.Path & "\Libro1.xls", _ "Tabla1", 10, 3) End Sub

Buscar en Recursos vb