30 noviembre, 2023

OBTENER DATOS DE OTRO ARCHIVO CON ADO E IMPORTAR VARIAS CONSULTAS EN TABLAS

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:

obtener datos de otro archivo con ado e importar varias consultas en tablas

En este archivo tenemos la siguiente información:

obtener datos de otro archivo con ado e importar varias consultas en tablas_1

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:

obtener datos de otro archivo con ado e importar varias consultas en tablas_2

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:

OBTENER DATOS DE OTRO ARCHIVO CON ADO E IMPORTAR VARIAS CONSULTAS EN TABLAS_3.jpg

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:

OBTENER DATOS DE OTRO ARCHIVO CON ADO E IMPORTAR VARIAS CONSULTAS EN TABLAS_4.jpg

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

Donate Button with Credit Cards

¿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

Comparte este post

5 comentarios en «OBTENER DATOS DE OTRO ARCHIVO CON ADO E IMPORTAR VARIAS CONSULTAS EN TABLAS»

  1. 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ú

      1. 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

        1. 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.

  2. 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.

Si te ha gustado o tienes alguna duda, puedes dejar aquí tu comentario.

Este sitio web utiliza cookies para que usted tenga la mejor experiencia de usuario. Si continúa navegando está dando su consentimiento para la aceptación de las mencionadas cookies y la aceptación de nuestra política de cookies, pinche el enlace para mayor información.plugin cookies

ACEPTAR
Aviso de cookies