Hola a todos!:
En esta web hay varios post dedicados a ADO y sus ventajas a la hora de obtener información a través de consultas. En el ejercicio de hoy os propongo lo siguiente:
Pulsando un botón de comando en nuestra hoja procederemos a seleccionar un archivo, previamente indicaremos ciertos criterios en cada consulta y lanzaremos nuestro proceso. A continuación obtendremos la información y la importaremos a nuestra hoja.
Veamos el proceso con vídeo:
[wpvideo PAYxRG1N]
Efectivamente en una carpeta tenemos el siguiente archivo:

En este archivo tenemos la siguiente información:

Y queremos importarnos tres consultas de esta base de datos:
1: Empleados con ID > que 9 y queremos Nombre Completo e ID.
2: Empleados que solo sean Mujeres y traemos ID, Nombre Completo y Estudios.
3: Empleados cuyos estudios son Licenciados y nos traemos ID, Nombre Completo y Edad.
Estas consultas se realizarán en SQL desde nuestro código. Lo primero que debemos hacer es seleccionar el archivo BASE_DATOS para obtener la información.
Eso lo realizaremos con el siguiente código:
narchivos = Application.GetOpenFilename(filefilter:="Excel (*.xls*),*.xls", _
Title:="SELECCIONAR ARCHIVO", MultiSelect:=False)
If narchivos = False Then Exit Sub
Seleccionamos archivo:

Una vez que lo tenemos seleccionado, ya podemos pasar las consultas, serían estas:
obSQL = " SELECT [Hoja1$].[ID], [Hoja1$].[NOMBRE COMPLETO] FROM [Hoja1$] WHERE [Hoja1$].[ID]> 9"
obSQL1 = " SELECT [Hoja1$].[ID], [Hoja1$].[NOMBRE COMPLETO], [Hoja1$].[ESTUDIOS] FROM [Hoja1$] WHERE [Hoja1$].[SEXO]= 'MUJER'"
obSQL2 = " SELECT [Hoja1$].[ID], [Hoja1$].[NOMBRE COMPLETO], [Hoja1$].[EDAD] FROM [Hoja1$] WHERE [Hoja1$].[ESTUDIOS]= 'LICENCIADOS'"
Ahora debemos utilizar el resto de la macro
'Iniciamos un loop que recorra todas las consultas (las incluimos en un array)
For Each consulta In Array(obSQL, obSQL1, obSQL2)
'Iniciamos la conexión con la base de datos
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Connectionstring = "DATA SOURCE=" & narchivos
.Properties("Extended Properties") = "Excel 8.0"
.Open
End With
'Grabamos los datos
Set Dataread = New ADODB.Recordset
With Dataread
.Source = consulta
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
With Sheets("Hoja1")
'Pasamos datos a la hoja
.Cells(2, d).CopyFromRecordset Dataread
'Incluimos encabezados
For i = 0 To Dataread.Fields.Count - 1
If IsDate(Dataread.Fields(i).Name) Then
Titulos = CDate(Dataread.Fields(i).Name)
Else
Titulos = Dataread.Fields(i).Name
End If
.Cells(1, d + i) = Titulos
Next i
'Convertimos cada consulta en una tabla
fin = .Cells(Rows.Count, d).End(xlUp).Row
Range(.Cells(1, d), .Cells(fin, d + i - 1)).Select
Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, ,xlYes)
objTable.Name = "Tabla" & x
End With
d = d + i + 1
x = x + 1
Next consulta
'Liberamos variables
Dataread.Close: Set Dataread = Nothing
cnn.Close: Set cnn = Nothing
El resultado de nuestro proceso es el siguiente:

Como podéis observar, hemos ejecutado las tres consultas en el mismo módulo utilizando una instrucción for – each en una matriz que va generando las consultas una a una. Cada vez que recibimos los datos, los importamos y de damos formato tabla.
Esto último es importante, dado que si vinculamos gráficos o tablas dinámicas a esta información, no tenemos que escribir código adicional si aumenta el rango de datos, siempre haremos referencia a la tabla (que además hemos renombrado).
Trabajando con ADO resulta mucho más sencillo obtener la información, y con nuestro código podemos transformarla hasta obtener lo que necesitamos. Por ello, y aunque ya lo indico siempre que trabajamos con ADO, debéis activar las referencias en vuestro editor de de VBA:

En resumen, la idea es no sobrecargar nuestra hoja de Excel de datos que no necesitamos, simplemente, seleccionamos el archivo fuente e importamos la información de interés previamente seleccionada con consultas.
Para finalizar, os dejo la macro completa:
Option Explicit
Sub CONSULTAS_SQL_ADO()
'Definimos variables
Dim Dataread As ADODB.Recordset, cnn As ADODB.Connection, Titulos As String, objTable As Variant
Dim d As Double, x As Double, i As Double, fin As Double, narchivos As Variant
Dim consulta As Variant, obSQL As String, obSQL1 As String, obSQL2 As String
Dim Table As Variant
'Seleccionamos archivos
Application.ScreenUpdating = False
narchivos = Application.GetOpenFilename(filefilter:="Excel (*.xls*),*.xls", _
Title:="SELECCIONAR ARCHIVO", MultiSelect:=False)
If narchivos = False Then Exit Sub
'Eliminamos tablas insertadas en consultas anteriores
For Each Table In ActiveSheet.ListObjects
Table.Delete
Next Table
'Definimos consultas
obSQL = " SELECT [Hoja1$].[ID], [Hoja1$].[NOMBRE COMPLETO] FROM [Hoja1$] WHERE [Hoja1$].[ID]> 9"
obSQL1 = " SELECT [Hoja1$].[ID], [Hoja1$].[NOMBRE COMPLETO], [Hoja1$].[ESTUDIOS] FROM [Hoja1$] WHERE [Hoja1$].[SEXO]= 'MUJER'"
obSQL2 = " SELECT [Hoja1$].[ID], [Hoja1$].[NOMBRE COMPLETO], [Hoja1$].[EDAD] FROM [Hoja1$] WHERE [Hoja1$].[ESTUDIOS]= 'LICENCIADOS'"
d = 1
x = 1
'Iniciamos un loop que recorra todas las consultas (las incluimos en un array)
For Each consulta In Array(obSQL, obSQL1, obSQL2)
'Iniciamos la conexión con la base de datos
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Connectionstring = "DATA SOURCE=" & narchivos
.Properties("Extended Properties") = "Excel 8.0"
.Open
End With
'Grabamos los datos
Set Dataread = New ADODB.Recordset
With Dataread
.Source = consulta
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
With Sheets("Hoja1")
'Pasamos datos a la hoja
.Cells(2, d).CopyFromRecordset Dataread
'Incluimos encabezados
For i = 0 To Dataread.Fields.Count - 1
If IsDate(Dataread.Fields(i).Name) Then
Titulos = CDate(Dataread.Fields(i).Name)
Else
Titulos = Dataread.Fields(i).Name
End If
.Cells(1, d + i) = Titulos
Next i
'Convertimos cada consulta en una tabla
fin = .Cells(Rows.Count, d).End(xlUp).Row
Range(.Cells(1, d), .Cells(fin, d + i - 1)).Select
Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, xlYes)
objTable.Name = "Tabla" & x
End With
d = d + i + 1
x = x + 1
Next consulta
'Liberamos variables
Dataread.Close: Set Dataread = Nothing
cnn.Close: Set cnn = Nothing
End Sub
Y con esto tenemos ya creado nuestro proceso de información para la generación de cualquier tipo de informe o reporte.
Espero que os haya resultado de interés.
Descarga el archivo de ejemplo pulsando en:
Y también el archivo de la base de datos para que realicéis la prueba: BASE DATOS

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.
¡¡Muchas gracias!!
Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies
Buen post Santiago
Recién descubro tu página y no me canso de leer.
Sobre este post en particular tengo una consulta.
Tengo una columna con unos id de casos que tengo que encontrar en una hoja, en un libro, en una carpeta de red. Se debe hacer 30 consultas sobre el estado de id diferentes y devolver todas las coincidencias en columnas con valores tal como en este post.
Se podría en vez de establecer las consultas, seleccionar un rango de celdas donde el usuario ingresara los id a consultar y mas bien dejar establecida la carpeta donde realizar las búsquedas. No se si me explico. Al revés de este Post, seleccionar la consulta a buscar en vez de la carpeta y el libro porque ya estaría establecida.
Si se pudiera, como se haría y/o donde se tendría que cambiar los datos. Recién estoy ingresando al mundo del vba y soy neófito total.
Espero me puedas ayudar.
Saludos desde Perú
Hola Oz:
Creo que lo mejor para el ejercicio que deseas hacer, es que lo hagas con un buscarv programado y no con ADO, si estás empezando podría ser muy complejo.
Te recomiendo este post:
https://excelsignum.com/2016/07/26/utilizar-cuadro-de-dialogo-para-seleccionar-archivo-y-buscarv/
Gracias por responder Santiago,
Esto es lo que he logrado hasta el momento, pide un numero de id, hace la búsqueda en otra hoja del mismo libro, devuelve todas las coincidencias del numero buscado y muestra sola las columnas solicitadas de la coincidencia.
Sub BuscarCASO()
fila = 8
dato = InputBox(«INGRESE N° DE CASO», «BUSCAR CASO»)
If dato = False Then Exit Sub
Set busca = Sheets(«hoja1»).Range(«B2:B» & Sheets(«hoja1»).Range(«B65000»).End(xlUp).Row).Find(dato, LookIn:=xlValues, LookAt:=xlWhole)
If Not busca Is Nothing Then
ubica = busca.Address
Do
Sheets(«Buscar_Caso»).Cells(fila, 2).Value = busca
Sheets(«Buscar_Caso»).Cells(fila, 3).Value = busca.Offset(0, 8)
Sheets(«Buscar_Caso»).Cells(fila, 4).Value = busca.Offset(0, 9)
Sheets(«Buscar_Caso»).Cells(fila, 5).Value = busca.Offset(0, 10)
Sheets(«Buscar_Caso»).Cells(fila, 6).Value = busca.Offset(0, 17)
Sheets(«Buscar_Caso»).Cells(fila, 7).Value = busca.Offset(0, 18)
Sheets(«Buscar_Caso»).Cells(fila, 8).Value = «hoja1»
fila = fila + 1
Set busca = Sheets(«hoja1»).Range(«B2:B» & Sheets(«hoja1»).Range(«B65000»).End(xlUp).Row).FindNext(busca)
Loop While Not busca Is Nothing And busca.Address ubica
End If
End Sub
Lo que no hace es buscar varios id al mismo tiempo, ya creo que solucione el tema de la carpeta en Red con dirección UNC y estoy en prueba error X-). Me pareció que lo expuesto en este post se aproxima mas a lo que necesito, y me parece ademas que es más potente.
He leído el post que me recomiendas y he leído bastante de tus post y me parece que con este puedo igualar columna a columna ingresando varios id a buscar, pero también he notado que no devuelve todas las coincidencias.
https://excelsignum.com/2016/04/21/buscar-con-varios-criterios-en-vba/
Y en este que comentamos, me parece que tiene la «potencia» necesaria para ser lo que necesito. Que te parece si me ayudas a acomodarlo, de paso practicas tu paciencia conmigo. :-).
Saludos.
P.S.: Perdón por el indentado
Hola Oz: Me llamo Segu.
Respondiendo a tu consulta, tendrás que enviar a excelsignum@yahoo.es un archivo de ejemplo en el que indiques detalladamente qué es lo que necesitas hacer. Es decir un ejemplo del ejercicio completo, indicando los datos de partida con los que cuentas, los datos que quieres buscar (donde y de qué forma) y el resulta de como debería quedar esa búsqueda.
Actualmente estoy respondiendo a varias consultas y es posible que tarde unos días en responder.
Saludos.
Hola Segu.
Te dije Santiago, no?. Discúlpame, no se lo que pensaba!. seguro le pedía al Santiago que me iluminara.
Gracias por responder. Te envío el archivo de ejemplo. Espero me puedas responder a la brevedad posible. :-).
Éxitos y gracias por compartir tus conocimientos.
Saludos.