Blog

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

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:

#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, "http://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, "http://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, "http://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)

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