Hola a toda mi linda gente de Perú! Hoy veremos cómo crear una aplicación en Excel para poder Buscar dni por nombre
Espero sea de su agrado esta publicación, y sin más preámbulos empecemos
Descarga el archivo ‘Buscar dni por nombre.xlsm’ al final de la publicación
Al igual que mis otras publicaciones, listaré los pasos a seguir para poder obtener el producto que necesitamos
Si tienes algún proyecto en logística o comercial, me interesaría participar. Puedes contactarme al correo luisrojas@tutorialesexcel.com
Ing. Luis Rojas
Paso #1 – Diseñando la interfaz de búsqueda
Bueno vamos a realizar un pequeño diseño muy práctico, el cual nos ayudará a realizar la consulta
La hoja tendrá el nombre visible Luis Rojas y como el nombre que usaremos desde VBA wLuisRojas
Paso #2 – Conectarse a la web el eldni.com
Hace una semana publiqué diferentes páginas web desde donde podemos buscar información de personas (VER PUBLICACIÓN)
Usaremos una conexión a la página web eldni.com/buscar-por-nombres desde Excel, analizando rápidamente la web podemos ver que…
…Tenemos un token, oculto en un input hidden, por lo que la comunicación con el servidor puede ser un poco difícil si lo vamos a hacer con el típico envío por POST
Para realizar una búsqueda debemos tener al menos un nombre y un apellido
Escribiremos el siguiente código entonces
1 2 3 4 5 6 7 |
With wLuisRojas If (IsEmpty(.Range("D4")) = True And IsEmpty(.Range("D6")) = True) Or (IsEmpty(.Range("D4")) = True And IsEmpty(.Range("D8")) = True) Then MsgBox "Error, debe ingresar un nombre y el apellido paterno", vbInformation, "TutorialesExcel.com" Exit Sub End If .Range("D13", "G" & Rows.Count) = Empty End With |
Después de validada la condición, debemos crear un objeto Internet Explorer (Ingresaremos la información por ID)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 |
Dim ie As Object With wLuisRojas If (IsEmpty(.Range("D4")) = True And IsEmpty(.Range("D6")) = True) Or (IsEmpty(.Range("D4")) = True And IsEmpty(.Range("D8")) = True) Then MsgBox "Error, debe ingresar un nombre y el apellido paterno", vbInformation, "TutorialesExcel.com" Exit Sub End If .Range("D13", "G" & Rows.Count) = Empty Set ie = CreateObject("InternetExplorer.Application") ie.Visible = 0: ie.navigate "//eldni.com/buscar-por-nombres" Do DoEvents Loop Until ie.readyState = 4 If Not IsEmpty(.Range("D4")) Then ie.document.getElementById("nombres").Value = .Range("D4") If Not IsEmpty(.Range("D6")) Then ie.document.getElementById("apellido_p").Value = .Range("D6") If Not IsEmpty(.Range("D8")) Then ie.document.getElementById("apellido_m").Value = .Range("D8") ie.document.getElementsByTagName("button")(0).Click ie.Quit End With |
Validamos si está vacío el rango D4, D6 y D8 antes de enviarlo al objeto internet explorer porque sino enviaríamos un valor indefinido
Paso #3 – Obtener el resultado de la consulta en HTML
Muy bien, el envío se hace mediante un POST, y la página recarga cada vez que realizamos una búsqueda (Demora varios segundos)
Cada vez que realizamos una búsqueda, la página nos devuelve la palabra RESULTADO, esta palabra la usaremos en nuestro código
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 |
Dim ie As Object, pin As Boolean, Contenido$, i%, fila% With wLuisRojas If (IsEmpty(.Range("D4")) = True And IsEmpty(.Range("D6")) = True) Or (IsEmpty(.Range("D4")) = True And IsEmpty(.Range("D8")) = True) Then MsgBox "Error, debe ingresar un nombre y el apellido paterno", vbInformation, "TutorialesExcel.com" Exit Sub End If .Range("D13", "G" & Rows.Count) = Empty Set ie = CreateObject("InternetExplorer.Application") ie.Visible = 0: ie.navigate "//eldni.com/buscar-por-nombres" Do DoEvents Loop Until ie.readyState = 4 If Not IsEmpty(.Range("D4")) Then ie.document.getElementById("nombres").Value = .Range("D4") If Not IsEmpty(.Range("D6")) Then ie.document.getElementById("apellido_p").Value = .Range("D6") If Not IsEmpty(.Range("D8")) Then ie.document.getElementById("apellido_m").Value = .Range("D8") ie.document.getElementsByTagName("button")(0).Click End With pin = False Do DoEvents Application.Wait (Now + TimeValue("00:00:02")) Contenido = ie.document.getElementsByTagName("body")(0).innerHtml If InStr(UCase(Contenido), "RESULTADO") > 0 Then pin = True End If Loop Until pin = True Contenido = ie.document.getElementsByTagName("tbody")(0).innerHtml ie.Quit |
La variable Contenido inicialmente almacenará el código HTML del body, después de dar clic sobre el botón Buscar
He creado una variable Boolean llamada pin, que cambiará a True cuando el código encuentre la palabra RESULTADO en la variable Contenido, este proceso se hará cada dos segundos
Después de obtener el resultado de la web, la variable Contenido almacenará el valor del tbody de la tabla
Paso #4 – Limpiar la data recibida y listar en Excel
Continuando con el código anterior, necesitamos limpiar la data almacenada en la variable Contenido
Debemos tener en cuenta que también recibiremos publicidad por que es necesario eliminar esta parte
Este código será de mucha utilidad
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 |
Public AlmacenFila() As String, DetalleFila() As String Sub MTCBusqueda() ... Contenido = ie.document.getElementsByTagName("tbody")(0).innerHtml ie.Quit Contenido = Replace(Contenido, Chr(34), "") Contenido = Replace(Contenido, " scope=row", "") Contenido = Replace(Contenido, " class=text-left", "") Contenido = Replace(Contenido, "th", "td") Contenido = Replace(Contenido, Chr(10), "") Contenido = Replace(Contenido, Chr(13), "") Contenido = Replace(Contenido, "<tr>", "") Contenido = Replace(Contenido, "<td>", "") Contenido = Application.WorksheetFunction.Trim(Contenido) AlmacenFila = Split(Contenido, "</tr>") fila = 13 For i = LBound(AlmacenFila) To UBound(AlmacenFila) If listarAlmacen(AlmacenFila(i)) = True Then wLuisRojas.Range("D" & fila) = Application.WorksheetFunction.Trim(DetalleFila(0)) wLuisRojas.Range("E" & fila) = Application.WorksheetFunction.Trim(DetalleFila(1)) wLuisRojas.Range("F" & fila) = Application.WorksheetFunction.Trim(DetalleFila(2)) wLuisRojas.Range("G" & fila) = Application.WorksheetFunction.Trim(DetalleFila(3)) fila = fila + 1 End If Next 'asignarAlmacen Contenido End Sub Function listarAlmacen(InfoFila As String) As Boolean On Error GoTo sale DetalleFila = Split(InfoFila, "</td>") If Len(DetalleFila(0)) > 150 Or Len(DetalleFila(0)) = 0 Then sale: listarAlmacen = False Else listarAlmacen = True End If End Function |
Para eliminar la publicidad la función ListarAlmacen nos ayudará. Y toda la data la almacenaremos en arrays públicos
Y esto es todo, con este código ya hemos terminado, el código completo será
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 |
Public AlmacenFila() As String, DetalleFila() As String Sub MTCBusqueda() Dim ie As Object, pin As Boolean, Contenido$, i%, fila% With wLuisRojas If (IsEmpty(.Range("D4")) = True And IsEmpty(.Range("D6")) = True) Or (IsEmpty(.Range("D4")) = True And IsEmpty(.Range("D8")) = True) Then MsgBox "Error, debe ingresar un nombre y el apellido paterno", vbInformation, "TutorialesExcel.com" Exit Sub End If .Range("D13", "G" & Rows.Count) = Empty Set ie = CreateObject("InternetExplorer.Application") ie.Visible = 0: ie.navigate "//eldni.com/buscar-por-nombres" Do DoEvents Loop Until ie.readyState = 4 If Not IsEmpty(.Range("D4")) Then ie.document.getElementById("nombres").Value = .Range("D4") If Not IsEmpty(.Range("D6")) Then ie.document.getElementById("apellido_p").Value = .Range("D6") If Not IsEmpty(.Range("D8")) Then ie.document.getElementById("apellido_m").Value = .Range("D8") ie.document.getElementsByTagName("button")(0).Click End With pin = False Do DoEvents Application.Wait (Now + TimeValue("00:00:02")) Contenido = ie.document.getElementsByTagName("body")(0).innerHtml If InStr(UCase(Contenido), "RESULTADO") > 0 Then pin = True End If Loop Until pin = True Contenido = ie.document.getElementsByTagName("tbody")(0).innerHtml ie.Quit Contenido = Replace(Contenido, Chr(34), "") Contenido = Replace(Contenido, " scope=row", "") Contenido = Replace(Contenido, " class=text-left", "") Contenido = Replace(Contenido, "th", "td") Contenido = Replace(Contenido, Chr(10), "") Contenido = Replace(Contenido, Chr(13), "") Contenido = Replace(Contenido, "<tr>", "") Contenido = Replace(Contenido, "<td>", "") Contenido = Application.WorksheetFunction.Trim(Contenido) AlmacenFila = Split(Contenido, "</tr>") fila = 13 For i = LBound(AlmacenFila) To UBound(AlmacenFila) If listarAlmacen(AlmacenFila(i)) = True Then wLuisRojas.Range("D" & fila) = Application.WorksheetFunction.Trim(DetalleFila(0)) wLuisRojas.Range("E" & fila) = Application.WorksheetFunction.Trim(DetalleFila(1)) wLuisRojas.Range("F" & fila) = Application.WorksheetFunction.Trim(DetalleFila(2)) wLuisRojas.Range("G" & fila) = Application.WorksheetFunction.Trim(DetalleFila(3)) fila = fila + 1 End If Next 'asignarAlmacen Contenido End Sub Function listarAlmacen(InfoFila As String) As Boolean On Error GoTo sale DetalleFila = Split(InfoFila, "</td>") If Len(DetalleFila(0)) > 150 Or Len(DetalleFila(0)) = 0 Then sale: listarAlmacen = False Else listarAlmacen = True End If End Function |
Descargar ‘Buscar DNI por nombre.xlsm‘ (Contraseña: tutorialesexcel.com)
Únete gratis al GRUPO EXCEL SIN LÍMITES CLICK AQUÍ
Y eso ha sido todo, espero haber podido contribuir a tus conocimientos, cualquier duda o consulta me la puedes dejar en los comentarios o enviar un mensaje al correo luisrojas@tutorialesexcel.com
Una idea sobre “Buscar dni por nombre desde Excel”
excelente aporte amigo!