Consulta masiva de acreditados EsSalud GRATIS

Hola a todos mis seguidores! Hoy les daré un regalo y es la macro de Consulta masiva de acreditados EsSalud

Descargar ‘Consulta masiva de acreditados EsSalud.xlsm‘ GRATIS (Contraseña: tutorialesexcel.com)

Recuerda que puedes descargar todos mis archivos excel desde Repositorio Tutoriales Excel, la contraseña de todos los archivos es tutorialesexcel.com

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

Acreditaciones EsSalud — Captura de pantalla del POST anterior

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

Consulta masiva acreditacion EsSalud Excel

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:


#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


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


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


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í


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


'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


'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


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


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


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


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


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:


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


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:


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

Descargar ‘Consulta masiva de acreditados EsSalud.xlsm‘ GRATIS (Contraseña: tutorialesexcel.com)

EsSalud Búsqueda acreditados — Búsqueda individual EsSalud

Búsqueda masiva Acreditados EsSalud Excel — Búsqueda masiva Acreditados EsSalud

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

Cualquier consulta me la puedes realizar en los comentarios o al correo Luisrojas@tutorialesexcel.com

Si deseas realizar consultas masivas de DNI, te aconsejo comprar mi aplicación: CONSULTA INDIVIDUAL Y MASIVA DNI RENIEC EXCEL

Dejar un comentario Cancelar la respuesta

8 ideas sobre “Consulta masiva de acreditados EsSalud GRATIS”

8 Comentarios

Nelson Zapata
mayo 28, 2019, 2:29 pm

Quiero encontrar una persona solo con el nombre y apellido

Gracias

Responder
- Programador Autor
  mayo 28, 2019, 2:41 pm
  
  Hola Nelson, gracias por seguir mi blog. Haré un POST sobre este tema más adelante, pero te adelanto que sí es posible encontrar el DNI de una persona, sólo se necesita un nombre y el apellido paterno. Con el número de DNI puedes obtener mucha información
  
  Responder
roland
mayo 9, 2019, 11:27 am

Buenas al descargar el archivo no me retorna ningun resultado gracias

Responder
- Luis Rojas Autor
  mayo 9, 2019, 11:32 am
  
  Hola Roland, por favor actualiza el captcha y vuelve a intentarlo, caso contrario verifica si tu antivirus ha realizado algún bloqueo
  
  Responder
Merizalde
marzo 29, 2019, 4:00 pm

Uhmmmm, yo no pude bajarlo…

Responder
- Luis Rojas Autor
  marzo 29, 2019, 5:15 pm
  
  Hola Merizalde, te acabo de enviar el archivo de Consultas Acreditación EsSalud desde Excel a tu correo
  
  Responder
Claudia Zavala
febrero 27, 2019, 4:13 pm

Wow me encanta tu aplicativo, es más rápido que uno que compré
Muchas gracias por compartirlo gratis

Responder
- Luis Rojas Autor
  febrero 27, 2019, 4:37 pm
  
  De nada Claudia 🙂
  
  Responder