Hola a todos mis seguidores! Hoy les daré un regalo y es la macro de Consulta masiva de acreditados EsSalud
Para descargar la aplicación de consulta masiva, puedes hacer click en el siguiente enlace DESCARGAR GRATIS APLICACIÓN ESSALUD XLSM
Esta macro es 100% desarrollada por mí, y como todos mi desarrollos no tiene problemas con los antivirus
A continuación explicaré en 6 sencillos pasos la creación de esta macro
#1 – Resumen del análisis de Acreditación EsSalud
En la anterior publicación que realicé llegué a la conclusión que sólo es necesario ingresar el captcha de EsSalud una vez.
Las consultas siguientes se pueden realizar sin ningún problema ingresando un captcha erroneo
Muy bien, para poder realizar una Consulta masiva de acreditados EsSalud usaremos esta opción
No coloco un lector de captcha POST LECTOR DE CAPTCHA DESDE EXCEL porque haríamos muchos bucles
Debido a la ofuscación del captcha, lo podríamos leer después de varias iteraciones
Pero de acuerdo a mi publicación anterior, sólo es necesario leerlo bien una vez
#2 – Diseñando la interfaz de consulta individual y masiva Excel
Sí mi querido lector, lo primero que debemos hacer es diseñar las interfaces
He agregado un objeto activex Image, una imagen con el símbolo de refresh y dos formas (Buscar y Limpiar)
La fecha de nacimiento y el sexo se obtienen del autogenerado
Para la consulta masiva realizaré el siguiente diseño:
#3 – Programando el actualizar de Captchas VBA
El nombre de ambos objetos Image será IMGcaptcha, como se encuentran en diferentes hojas no habrá conflicto
El objetivo es que valor Picture de los objetos IMGcaptcha se actualice cuando se presione la imagen de Refresh
Para ello usaremos laAPI URLDownloadToFile, la declaramos de la siguiente forma:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 |
#If VBA7 And Win64 Then Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _ Alias "URLDownloadToFileA" ( _ ByVal pCaller As LongPtr, _ ByVal szURL As String, _ ByVal szFileName As String, _ ByVal dwReserved As LongPtr, _ ByVal lpfnCB As LongPtr _ ) As Long #Else Private Declare Function URLDownloadToFile Lib "urlmon" _ Alias "URLDownloadToFileA" ( _ ByVal pCaller As Long, _ ByVal szURL As String, _ ByVal szFileName As String, _ ByVal dwReserved As Long, _ ByVal lpfnCB As Long _ ) As Long #End If |
Código de actualización de captcha – consultas individuales
1 2 3 4 5 6 7 8 9 |
Sub actualizarCaptcha() On Error Resume Next URLDownloadToFile 0, "//ww4.essalud.gob.pe:7777/acredita/captcha.jpg", Application.ThisWorkbook.Path & "\captcha.jpg", 0, 0 wIndividual.IMGcaptcha.Picture = LoadPicture(Application.ThisWorkbook.Path & "\captcha.jpg") Kill Application.ThisWorkbook.Path & "\captcha.jpg" End Sub |
Código de actualización de captcha – Consultas masivas
1 2 3 4 5 6 7 8 9 |
Sub actualizarCaptchaMasiva() On Error Resume Next URLDownloadToFile 0, "//ww4.essalud.gob.pe:7777/acredita/captcha.jpg", Application.ThisWorkbook.Path & "\captcha.jpg", 0, 0 wMasivo.IMGcaptcha.Picture = LoadPicture(Application.ThisWorkbook.Path & "\captcha.jpg") Kill Application.ThisWorkbook.Path & "\captcha.jpg" End Sub |
El objetivo es obtener lo siguiente:
#4 – Código principal para la Consulta masiva de acreditados EsSalud
Muy bien! Como no me gusta programar dos veces lo mismo, haré que tanto la consulta individual como masiva accedan a una instrucción en común
Todos los valores obtenidos los almacenaré en un array y este será del tipo Private
1 2 3 |
Private valores(10) As String |
Como necesito limpiar constantemente el array en las consultas masivas, necesitaré un variable numérica que recorra valores del 0 al 10 y me consuma poca memoria (Byte)
Necesitaré 5 variables del tipo String, las cuales serán las siguientes:
- archivo : Ruta en donde se almacerá la web descargada
- lineaTexto : Almacenará cada línea de la web descargada
- contenido : Acumulará el contenido de lineaTexto
- busqueda1 : Guardará el texto de la primera cadena a buscar en la web descargada
- busqueda2 : Guardará el texto que limitará la cadena de texto a buscar en la web descargada
Programando el código principal de consultas EsSalud
La primera parte de nuestro código quedaría así
1 2 3 4 5 6 7 8 9 |
Sub consultarExSalud(DNI As String, Captcha As String) Dim archivo$, lineaTexto$, contenido$, busqueda1$, busqueda2$, i As Byte On Error Resume Next archivo = Application.ThisWorkbook.Path & "\pagina.web" Kill archivo URLDownloadToFile 0, "//ww4.essalud.gob.pe:7777/acredita/servlet/Ctrlwacre?captchafield_doc=" & Captcha & "&td=1&nd=" & DNI, archivo, 0, 0 End Sub |
Enviamos dos parámetros a esta macro, DNI y Captcha
Después de esto debemos hacer una lectura del archivo descargado con extensión .web
1 2 3 4 5 6 7 8 9 10 |
'Leer archivo de texto Open archivo For Input As #1 Do Until EOF(1) Line Input #1, lineaTexto$ contenido = contenido & lineaTexto$ Loop Close #1 'Leer archivo de texto |
Limpiar el arreglo, para ello usamos a i que es de tipo byte
1 2 3 4 5 6 7 |
'Limpiar arreglo valores For i = 0 To 10 valores(i) = Empty Next 'Limpiar arreglo valores |
El archivo con extensión web tendrá muchos espacios en blanco y saltos de línea, por lo que es necesario eliminarlos
1 2 3 |
contenido = Application.WorksheetFunction.Trim(contenido) |
Hasta este punto ya tenemos el archivo que necesitamos con extensión web, ahora debemos encontrar los datos que requerimos
Para agilizar el proceso usaré a una función
1 2 3 4 5 6 7 8 |
Function Resultado(lugar As String, valorBuscado1 As String, valorBuscado2 As String) As String Dim ubi1 As Long, ubi2 As Long ubi1 = InStr(lugar, valorBuscado1) ubi2 = InStr(lugar, valorBuscado2) Resultado = Application.WorksheetFunction.Trim(Mid(lugar, ubi1 + Len(valorBuscado1), ubi2 - ubi1 - Len(valorBuscado1))) End Function |
Mi función Resultado extraerá un texto contenido entre dos frases, el cual será el texto que deseamos obtener
Luego al resultado final le aplicacamos un Application.WorksheetFunction.Trim, que es la función espacios de Excel
Muy bien ahora sólo basta con encontrar el texto que necesitamos y lo haremos con el siguiente 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 37 38 39 40 41 42 43 |
busqueda1 = "<td width=244 valign=" & Chr(34) & "top" & Chr(34) & " class=" & Chr(34) & "tdDetRigth" & Chr(34) & "><B>" busqueda2 = "</B></td> <td width=143 valign=" & Chr(34) & "top" & Chr(34) & " class=" & Chr(34) & "tdDetLeft" & Chr(34) & "><b>" valores(0) = Resultado(contenido, busqueda1, busqueda2) busqueda1 = "<b>Tipo de Asegurado</b></td> <td valign=" & Chr(34) & "top" & Chr(34) & " class=" & Chr(34) & "tdDetRigth" & Chr(34) & ">" busqueda2 = "</td> <td valign=" & Chr(34) & "top" & Chr(34) & " class=" & Chr(34) & "tdDetLeft" & Chr(34) & " title=" & Chr(34) & "Código de Identificación del asegurado de EsSalud" & Chr(34) & "><b>Autogenerado" valores(1) = Resultado(contenido, busqueda1, busqueda2) busqueda1 = "<td valign=" & Chr(34) & "top" & Chr(34) & " class=" & Chr(34) & "tdDetRigth" & Chr(34) & " title=" & Chr(34) & "Código de Identificación del asegurado de EsSalud" & Chr(34) & " >" busqueda2 = "</td> </tr> <tr> <td valign=" & Chr(34) & "top" & Chr(34) & " class=" & Chr(34) & "tdDetLeft" & Chr(34) & "> </td>" valores(2) = Resultado(contenido, busqueda1, busqueda2) valores(3) = Mid(valores(2), 5, 2) & "/" & Mid(valores(2), 3, 2) & "/" & Mid(valores(2), 1, 2) valores(4) = IIf(Mid(valores(2), 7, 1) = 1, "Masculino", "Femenino") busqueda1 = "class=" & Chr(34) & "tdDetRigth" & Chr(34) & "title=" & Chr(34) & "Código de Identificación del asegurado de EsSalud" & Chr(34) & ">" busqueda2 = "</td> </tr> <tr> <td colspan=2 class=" & Chr(34) & "tdTitDet" & Chr(34) & "><img src=" & Chr(34) & "../images/bazul.gif" & Chr(34) & "" valores(5) = Resultado(contenido, busqueda1, busqueda2) busqueda1 = "Centro Asistencial</b></td> <td class=" & Chr(34) & "tdDetRigth" & Chr(34) & "><b>" busqueda2 = "</b></td> <td class=" & Chr(34) & "tdDetLeft" & Chr(34) & "" valores(6) = Resultado(contenido, busqueda1, busqueda2) busqueda1 = "Dirección C.A.</b></td> <td class=" & Chr(34) & "tdDetRigth" & Chr(34) & ">" busqueda2 = "</td> <td class=" & Chr(34) & "tdDetLeft" & Chr(34) & " title=" & Chr(34) & "Mes durante el cual puede acceder a los servicios de EsSalud" & Chr(34) & "><b>H" valores(7) = Resultado(contenido, busqueda1, busqueda2) busqueda1 = "Afiliado(a) a</b></td> <td class=" & Chr(34) & "tdDetRigth" & Chr(34) & ">" busqueda2 = "</td> <td class=" & Chr(34) & "tdDetLeft" & Chr(34) & ">" valores(8) = Resultado(contenido, busqueda1, busqueda2) busqueda1 = "Desde </b></td> <td class=" & Chr(34) & "tdDetRigth" & Chr(34) & "><b>" busqueda2 = "</b></td> </tr> <tr> <td class=" & Chr(34) & "tdDetLeft" & Chr(34) & "><b>Direcci&oacute" valores(9) = Left(Resultado(contenido, busqueda1, busqueda2), 10) busqueda1 = "Hasta </b></td> <td class=" & Chr(34) & "tdDetRigth" & Chr(34) & " ><b>" busqueda2 = "</b></td> </tr> <tr> <td class=" & Chr(34) & "tdDetLeft" & Chr(34) & "><b>Afiliado" valores(10) = Left(Resultado(contenido, busqueda1, busqueda2), 10) Kill Application.ThisWorkbook.Path & "\pagina.web" |
valores(3) y valores(4) se obtienen de una pequeña operación que hacemos a valores(2)
#5 – Programando la Consulta individual de acreditados EsSalud
Muy bien primero programaremos la consulta individual
Antes de realizar la consulta, debemos limpiar las casillas, por lo que usaremos este código
1 2 3 4 5 6 7 8 9 10 |
Sub limpiarIndividual() On Error Resume Next With wIndividual .Range("D10", "E15") = Empty .Range("I10", "J14") = Empty End With End Sub |
Esta macro la asignaremos al botón limpiar y también la llamaré al inicio de la consulta individual
Ahora, no deseo ver cómo se va imprimiendo la data, por lo que usaré a dos amigos
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
Sub Inicio() Application.DisplayAlerts = False Application.ScreenUpdating = False Application.Calculation = xlCalculationManual End Sub Sub Fin() Application.DisplayAlerts = True Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.StatusBar = Empty End Sub |
Inicio la llamaré antes de que realice la consulta, Fin la llamaré después de realizada la consulta
Y finalmente mi consulta individual será de la siguiente forma:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
Sub consultaIndividual() Inicio limpiarIndividual With wIndividual Application.StatusBar = "Consultando DNI " & .Range("D4") consultarExSalud .Range("D4"), .Range("D6") .Range("D10") = valores(0) .Range("D11") = valores(1) .Range("D12") = valores(2) .Range("D13") = valores(5) .Range("D14") = valores(3) .Range("D15") = valores(4) .Range("I10") = valores(6) .Range("I11") = valores(7) .Range("I12") = valores(8) .Range("I13") = valores(9) .Range("I14") = valores(10) End With Fin End Sub |
#6 – Programando la Consulta Masiva de acreditados EsSalud
De manera similar al caso anterior, primero programaremos la limpieza masiva, quedando de la siguiente forma
1 2 3 4 5 6 7 8 9 10 |
Sub limpiarMasivo() Dim n As Long With wMasivo n = .Range("A" & Rows.Count).End(xlUp).Row n = IIf(n < 2, 2, n) .Range("A2", "L" & n) = Empty End With End Sub |
Uso a IIF por si el listado se encuentra vacío
Para la consulta masiva realizaremos lo siguiente:
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 |
Sub consultaMasivo() Dim n&, i& Inicio With wMasivo n = .Range("A1").CurrentRegion.Rows.Count For i = 2 To n Application.StatusBar = "Consultando " & i - 1 & " de " & n - 1 consultarExSalud .Range("A" & i), .Range("P2") .Range("B" & i) = valores(0) .Range("C" & i) = valores(1) .Range("D" & i) = valores(2) .Range("E" & i) = valores(5) .Range("F" & i) = valores(3) .Range("G" & i) = valores(4) .Range("H" & i) = valores(6) .Range("I" & i) = valores(7) .Range("J" & i) = valores(8) .Range("K" & i) = valores(9) .Range("L" & i) = valores(10) Next End With Fin End Sub |
He modificado el StatusBar para que se muestre qué consulta se está ejecutando, aunque no es necesario porque mi aplicativo es muy rápido
Descarga el aplicativo complemente GRATIS
Muy bien todo el código que necesitamos lo encontramos líneas arriba, si deseas el aplicativo lo puedes descargar en el siguiente enlace:
DESCARGAR GRATIS APLICACIÓN ESSALUD XLSM
Lo único que deben realizar es completar correctamente el captcha antes de hacer cualquier consulta, ya sea individual o masiva
Espero te haya servido mi publicación, si te gustó por favor regálame un comentario, me ayudarías mucho
Jh
Cualquier consulta me la puedes realizar en los comentarios o al correo contacto@tutorialesexcel.com
Si deseas realizar consultas masivas de DNI, te aconsejo comprar mi aplicación: CONSULTA INDIVIDUAL Y MASIVA DNI RENIEC EXCEL
2 ideas sobre “Consulta masiva de acreditados EsSalud GRATIS”
Wow me encanta tu aplicativo, es más rápido que uno que compré
Muchas gracias por compartirlo gratis
De nada Claudia 🙂