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:

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: OBTENER DATOS CON ADO E IMPORTAR 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.

Donate Button with Credit Cards

¡¡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

Anuncios

CARGAR DATOS EN LISTBOX Y REALIZAR BÚSQUEDAS CON ADO Y CONSULTAS SQL

Aunque estoy preparando varios post sobre análisis estadístico de los datos, hoy trataré sobre algo totalmente diferente, los listbox en formularios y la posibilidad de utilizar ADO y las consultas de SQL para buscar y filtrar información.

Vamos seguidamente con un ejemplo para ilustrar el ejercicio. Utilizaré el listado de alumnos que usé para el post de las funciones matriciales, este:

CARGAR DATOS EN LISTBOX Y REALIZAR BUSQUEDAS CON ADO Y CONSULTAS SQL

Y ahora vamos a construir un sencillo formulario en el que vamos a incluir 5 listbox en los que mostraremos la información de la hoja ALUMNOS y también un cuadro de texto (textbox) y un botón de comando para realizar las búsquedas:

Ahora vamos utilizar el siguiente código VBA que vamos a pegar en el evento click del botón de búsqueda, luego lo iremos comentando:

Private Sub CommandButton1_Click()
'Definimos las variables
Dim Dataread As ADODB.Recordset, obSQL As String
Dim cnn As ADODB.Connection, MiLibro As String
Dim Control As control, Nombre As String
'Vaciamos todos los Listbox
For Each control In Me.Controls
If TypeName(Control) = "ListBox" Then
Control.Clear
End If
Next
'grabamos el dato a buscar, si no hay dato la variable Nombre es nula
Nombre = IIf(UCase(Me.TextBox1.Value) = vbNullString, IsNull(Me.TextBox1.Value), UCase(Me.TextBox1.Value))
'Creamos la instrucción SQL según los parámetros que nos interesan, en este caso, el nombre
'y los diferentes carácteres comodín y el operador "like"
obSQL = "SELECT [ALUMNOS$].* " & _
"FROM [ALUMNOS$] " & _
"Where [ALUMNOS$].[NOMBRE] like " & "'%" & Nombre & "%'"
'Guardamos el nombre del libro activo para utilizarlo en la conexión ADO
MiLibro = ActiveWorkbook.Name
'Dejamos el cuadro de búsqueda vacío después de iniciar la consulta
Me.TextBox1.Value = vbNullString
'Iniciamos la conexión ADO
Set cnn = New ADODB.Connection
With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "DATA SOURCE=" & Application.ActiveWorkbook.Path + "\" & MiLibro
.Properties("Extended Properties") = "Excel 8.0"
.Open
End With
'Procedemos a grababar los datos de la consulta
Set Dataread = New ADODB.Recordset
With Dataread
.Source = obSQL
.ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
Do Until Dataread.EOF
'Pasamos la información a cada ListBox a través del recordset
With UserForm1
.ListBox1.AddItem Dataread("ID")
.ListBox2.AddItem Dataread("NOMBRE")
.ListBox3.AddItem Dataread("CLASE")
.ListBox4.AddItem Dataread("ASIGNATURAS")
.ListBox5.AddItem Dataread("CALIFICACIONES")
End With
Dataread.MoveNext
Loop
'Liberamos y cerramos variables
Dataread.Close: Set Dataread = Nothing
cnn.Close: Set cnn = Nothing
End Sub

Con esta macro podremos realizar consultas a través de lo que indiquemos en el cuadro de búsqueda del formulario (textbox1) o lo que es lo mismo, en la variable “Nombre”.

Pero vamos explicando poco a poco el código. Para borrar o limpiar los datos que van a contener los listbox durante las sucesivas búsquedas tenemos que utilizar el siguiente proceso.

For Each control In Me.Controls
If TypeName(Control) = "ListBox" Then
Control.Clear
End If
Next

Una vez que tenemos los listbox libres de datos ya podemos iniciar la consulta SQL:

obSQL = "SELECT [ALUMNOS$].* " & _
"FROM [ALUMNOS$] " & _
"Where [ALUMNOS$].[NOMBRE] like " & "'%" & Nombre & "%'"

Me gustaría comentar que aquí utilizamos el dato contenido en la variable “Nombre”, importante para poder utilizar el operador Like y por lo tanto, comodines en nuestra consulta.

Cuando la información del cuadro de texto está vacía, simplemente no mostrará nada en los listbox, eso es porque he introducido mediante una condición que si el dato de búsqueda es vacío, entonces es nulo (y por eso no muestra nada).

Nombre = IIf(UCase(Me.TextBox1.Value) = vbNullString, IsNull(Me.TextBox1.Value), UCase(Me.TextBox1.Value))

Podríamos quitar la condición y entonces al pulsar “Buscar” y cargaríamos todos los datos en los listbox, pero creo que así es más funcional.

En la parte condicional de la sentencia SQL, estamos indicando mediante el uso de caracteres comodín, que se busquen los nombres que empiecen por la información escrita en el textbox.

"Where [ALUMNOS$].[NOMBRE] like " & "'" & Nombre & "%'"

Por ejemplo, todos los nombre que empiecen por “MA”:

CARGAR DATOS EN LISTBOX Y REALIZAR BUSQUEDAS CON ADO Y CONSULTAS SQL2

Si queremos extraer los nombres que acaban en “A”, el código sería así:

"Where [ALUMNOS$].[NOMBRE] like " & "'%" & Nombre & "'"

Y el resultado este:

CARGAR DATOS EN LISTBOX Y REALIZAR BUSQUEDAS CON ADO Y CONSULTAS SQL3

Y si quisiéramos que se buscase el nombre a partir de cualquier fragmento de texto, simplemente colocaríamos “%” a ambos lados de la variable “Nombre”:

"Where [ALUMNOS$].[NOMBRE] like " & "'%" & Nombre & "%'"

y podríamos realizar búsquedas más abiertas, por ejemplo, todos los nombres que contengan “AL” (independientemente si está delante, en el centro o al final). Este es el resultado:

CARGAR DATOS EN LISTBOX Y REALIZAR BUSQUEDAS CON ADO Y CONSULTAS SQL4

Como podéis observar, la clave está en saber utilizar los caracteres comodín correctamente en la sentencia SQL. Es algo sencillo pero hay que tener especial cuidado con la posición de las comillas simples y los espacios.

Importante. Si la macro os muestra un error 3706 (que no encuentra el proveedor especificado), lo más probable es que sea un problema con las versiones de Excel y el proveedor que ha utilizado para este post:

.Provider = "Microsoft.Jet.OLEDB.4.0"

Debéis modificarlo por

.Provider = "Microsoft.ACE.OLEDB.12.0"

Por último, ya sabéis que para este tipo de método es necesario activar la referencia Microsoft ActiveX Data Object 2.8 Library en el editor de VBA.

En el archivo de descarga, la búsqueda de los nombres está condicionada a que contengan parte del dato contenido en el buscador.

Descarga el archivo de ejemplo pulsando en: CARGAR DATOS EN LISTBOX Y REALIZAR BÚSQUEDAS CON ADO Y CONSULTAS SQL