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ó"
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
Hola Luis, quería contactarte para tu asesoría en hacer esto mismo pero de la pagina SmsGateWay24 a la que tu también le desarrollaste un archivo de excel para enviar sms masivos
Quiero encontrar una persona solo con el nombre y apellido
Gracias
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
Buenas al descargar el archivo no me retorna ningun resultado gracias
Hola Roland, por favor actualiza el captcha y vuelve a intentarlo, caso contrario verifica si tu antivirus ha realizado algún bloqueo
Uhmmmm, yo no pude bajarlo…
Hola Merizalde, te acabo de enviar el archivo de Consultas Acreditación EsSalud desde Excel a tu correo
Wow me encanta tu aplicativo, es más rápido que uno que compré
Muchas gracias por compartirlo gratis
De nada Claudia 🙂