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:

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")
Do Until Dataread.EOF
Dataread.MoveFirst
'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
Loop
'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")
Do Until Dataread.EOF
Dataread.MoveFirst
'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
Loop
'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: OBTENER DATOS DE OTRO ARCHIVO CON ADO E IMPORTAR VARIAS CONSULTAS EN TABLAS

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