Macro para ejecutar una consulta SQL de un archivo de Excel a otro

En un artículo de este mismo Blog llamado Consultar datos de un archivo de Excel a otro mediante Microsoft Query y ODBC explicaba la manera de hacer consultas a un archivo de Excel desde otro sin involucrar ninguna macro.

En esta ocasión me di a la tarea de usar el Grabador de macros para obtener el código generado con dicho procedimiento. Al final fue cuestión de detallar algunas líneas de código para tener una macro que realice lo mismo, pero con la posibilidad de potenciarla y adecuarla a otros desarrollos que se nos ocurran.

Cómo funciona

Tenemos un archivo llamado Prueba2.xlsx del cual queremos obtener datos mediante una sentencia de SQL, pero sin necesidad de abrirlo y hacer filtros.

El archivo tiene una tabla con las columnas NOMBRE, SUELDO y EDAD y para este ejemplo se guardó en la ruta C:\Excel\.

Figura 1. Tabla de datos de donde se hará la consulta.

Cuando ejecutamos la macro lo primero que validará es que el archivo Prueba2.xlsx exista en la ruta, de lo contrario nos mostrará un diálogo para elegir la carpeta donde se encuentra.

Figura 2. Bucar ubicación del archivo para hacer la consulta.

Ejecutar Consulta

La consulta que haremos será traer todos los empleados con sueldo mayor a 1,000 y su edad se mayor a 25. La cual la expresamos en el siguiente código.

“SELECT `Hoja2$`.NOMBRE, `Hoja2$`.SUELDO, `Hoja2$`.EDAD” _
& Chr(13) & “” & Chr(10) & _
“FROM `” & Ruta & Nombre & “`.`Hoja2$` `Hoja2$`” _
& Chr(13) & “” & Chr(10) & _
“WHERE (`Hoja2$`.SUELDO > 1000 AND `Hoja2$`.EDAD > 25)”

El resultado será devuelto en una tabla de Excel y los datos se podrán refrecar con el comando Actualizar dando click derecho.

Figura 3. Se encontraron 21 empleados que coinciden con la consulta.

Código de la macro

Para que tengan todo para comenzar con sus pruebas, les comparto el código que usé en el ejemplo.

':: EXCELeINFO
':: Sergio A Campos H
':: 21-mar-2014
':: http://blogs.itpro.es/exceleinfo/
'
Option Explicit
Sub ConsultaExcel()
'
'Declaramos variables
'
Dim Ruta As String
Dim Nombre As String
Dim ElArchivo As String
Dim Resultado As String
'
On Error GoTo ErrorHandler
'
ActiveWorkbook.Sheets("Hoja1").Activate
'
Cells.ClearContents
'
Ruta = ActiveWorkbook.Sheets("DatosOrigen").Range("B1").Value
Nombre = ActiveWorkbook.Sheets("DatosOrigen").Range("B2").Value
'
ElArchivo = Ruta & Nombre
Resultado = Dir$(ElArchivo)
'
'Nos aseguramos de que exista el archivo, en caso contrario debemos
'especifica la ruta del archivo.
'
If Resultado = "" Then
    MsgBox "El archivo '" & Nombre & "' no se encuentra en '" & Ruta & "'", vbExclamation, "EXCELeINFO"
    '
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & " \ "
        .Title = "EXCELeINFO - Actualizar nueva carpeta"
        .Show
        If .SelectedItems.Count = 0 Then
        Else
            ActiveWorkbook.Sheets("DatosOrigen").Range("B1").Value = .SelectedItems(1) & "\"
        End If
        '
        Ruta = ActiveWorkbook.Sheets("DatosOrigen").Range("B1").Value
        '
        GoTo Datos
        '
    End With
Else
'
'Ejecutamos la consulta en el archivo
'
Datos:
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
        "ODBC;DSN=Excel files;DBQ=" & Ruta & Nombre & ";" _
        ), Array( _
        "DefaultDir=" & Ruta & ";DriverId=1046;FIL=excel 12.0;MaxBufferSize=2048;PageTimeout=5;")), _
        Destination:=Range("$A$1")).QueryTable
        .CommandText = Array( _
                       "SELECT `Hoja2$`.NOMBRE, `Hoja2$`.SUELDO, `Hoja2$`.EDAD" _
                       & Chr(13) & "" & Chr(10) & _
                       "FROM `" & Ruta & Nombre & "`.`Hoja2$` `Hoja2$`" _
                       & Chr(13) & "" & Chr(10) & _
                       "WHERE (`Hoja2$`.SUELDO > 1000 AND `Hoja2$`.EDAD > 25)")
        .Refresh BackgroundQuery:=False
    End With
End If
Exit Sub
'
'El caso de no encontrar el archivo o que la sintaxis esté incorrecta...
'
ErrorHandler:
MsgBox "Ha ocurrido un error: " & Err.Description & vbNewLine & _
       "Valide la ruta del archivo o la sintaxis de la consulta.", vbExclamation, "EXCELeINFO"
End Sub

Anexos

:: Descarga los ejemplos Macro para consultar de un archivo de Excel a otro.rar