En un post anterior os mostramos como copiar tablas de Access a Excel de forma rapida, evitando los problemas de usar copiar y pegar.

La Macro funcionaba bien, pero puede mejorarse de forma relativamente sencilla para que sea mas reutilizable.

1) La primera mejora es añadir la Macro al libro de Macros Personal, para que este disponible siempre que utilicemos Excel. Sino sabéis como realizarlo os recomiendo que veáis este post del blog de JDL Excel.

2) Reemplazar la entrada manual de la ruta y el nombre Access, mediante una ventana de selección de ficheros. Reemplazamos la instrucción

InputBox(«¿Ruta y nombre del fichero Access?»)

por

Application.GetOpenFilename(«Access (*.mdb), *.mdb», , «Seleccionar fichero Access»)

3) Reemplazar la entrada manual del nombre de la tabla o consulta por un selector que obtenga un listado de tablas y consultas disponibles. Esto implica la creación de un pequeño formulario y crear una lista de selección. Dada su complejidad y para no complicar este post, este punto lo trataremos en breve en otro post, cuando este publicado incluiremos un enlace.

*) El resultado final a falta de incorporar las mejoras del punto 3. El siguiente código dentro del libro de Personal:

‘==========================================
Public Sub Copiar_Tabla_Access()
Dim oConexion As ADODB.Connection
Dim rsTabla As ADODB.Recordset
Dim sNombreTabla As String
Dim sNombreAccess As String
Dim i As Integer

sNombreAccess = Application.GetOpenFilename( _
«Access (*.mdb), *.mdb», , «Seleccionar fichero Access»)

If sNombreAccess <> «» Then
sNombreTabla = InputBox(«¿nombre de la tabla/consulta?»)
Set oConexion = New ADODB.Connection
oConexion.CursorLocation = adUseClient
oConexion.Open «PROVIDER=Microsoft.Jet.OLEDB.4.0;» & _
«Data Source=» & sNombreAccess & «;»
Set rsTabla = New ADODB.Recordset
rsTabla.Open «Select * From [» & sNombreTabla & «]», _
oConexion, _
adOpenStatic
ActiveSheet.Cells.CopyFromRecordset rsTabla
ActiveSheet.Rows(«1:1»).Insert Shift:=xlDown
For i = 0 To rsTabla.Fields.Count – 1
ActiveSheet.Cells(1, i + 1).Value = rsTabla.Fields(i).Name
Next
rsTabla.Close
oConexion.Close
Set rsTabla = Nothing
Set oConexion = Nothing
End If
End Sub
‘==========================================

Be Sociable, Share!