Blog

Un saludo a mi gente linda de Perú, hoy veremos un nuevo aplicativo llamado Consulta REMYPE desde Excel VBA

Este aplicativo se conecta al portal web http://gestion.trabajo.gob.pe/consultas-remype/app/ y nos devuelve la información de manera individual o masiva

La lógica de programación es muy parecida a las ya existentes en el portal, con la cual la programamos simple y rápido

Bueno, podemos descargar el aplicativo en el siguiente link

Explicaré brevemente el desarrollo y funcionamiento del mismo

Paso 1: Diseño de la interfaz del aplicativo Consulta REMYPE desde Excel VBA

Lo primero que vamos a realizar es el diseño de la interfaz, para lo cual contaremos con 3 hojas

• Hoja Individual
• Hoja Masiva
• Hoja Config

• 

• 

• 

Paso 2: Desarrollo de la función de consulta

Crearemos una función que se encargará de realizar el trabajo duro, esta función trabajará con un array y una constante

Public ConsultaREMYPE(11) As String
Const webREMYPE As String = "http://gestion.trabajo.gob.pe/consultas-remype/consulta/remype.tra"

Function ConsultaRUCREMYPE(nEnviado As String) As Boolean
    Dim Respuesta$, enviado$
    Dim Solicitud As Object
    
    Dim i As Byte, n As Byte
    
    Set Solicitud = CreateObject("winhttp.winhttprequest.5.1")
    'Consulta Datos a web Consulta RUC
        enviado = "{" & Chr(34) & "ruc" & Chr(34) & ":" & Chr(34) & nEnviado & Chr(34) & "}"
        Solicitud.Open "POST", webREMYPE, False
        Solicitud.setrequestheader "Content-type", "application/json;charset=utf-8"
        Solicitud.send (enviado)
        Respuesta = Solicitud.responsetext
    '--------------------------------
    
    
    'Validar
        If InStr(Respuesta, "[]") > 0 Then
            ConsultaRUCREMYPE = False
            Exit Function
        End If
    '--------------------------------
    
    'Limpiar array
        n = wConfig.Range("A1").CurrentRegion.Rows.Count
        For i = 2 To n
            ConsultaREMYPE(i - 2) = Empty
        Next
    '--------------------------------
    
    'Obtener la data requerida
        For i = 2 To n
            If wConfig.Range("B" & i) = "SI" Then
                ConsultaREMYPE(i - 2) = limpiarRespuesta(Respuesta, wConfig.Range("A" & i), wConfig.Range("A" & i + 1))
            End If
        Next
    '--------------------------------
    
    ConsultaRUCREMYPE = True
End Function

Esta función al momento de asignar cada valor al array utilizará una función de limpieza

Function limpiarRespuesta(Resp As String, pi As String, Optional pf As String) As String
    Dim devu$, posi%, posf%
    
    posi = InStr(Resp, pi) + Len(pi)
    If pf = Empty Then
        pf = "]"
    End If
    posf = InStr(Resp, pf) - 1
    devu = Mid(Resp, posi, posf - posi)
    devu = Replace(devu, ":", "")
    devu = Replace(devu, ",", "")
    devu = Replace(devu, Chr(34), "")
    devu = Replace(devu, Chr(10), "")
    devu = Replace(devu, Chr(13), "")
    devu = Replace(devu, Chr(92), "")
    
    devu = Application.WorksheetFunction.Trim(devu)
    limpiarRespuesta = devu
End Function

El uso de JsonConverter es ideal cuando tenemos campos desconocidos o la cadena a leer es muy compleja

Ing. Luis Rojas

Paso 3: Desarrollo del código de consulta individual y masiva

Vale, el código difícil es el del paso 2, en este paso solo crearemos procedimientos que utilicen el código del paso 2

El código de consulta y limpieza individual será:

Sub ConsultaIndividual()
    On Error Resume Next
    Dim ndocumento As String, i As Byte, n As Byte, c As Byte
    ndocumento = wIndividual.Range("C3")
    
    VelocidadTutorialesExcel.inicio
    
    'Validar y calcular lo necesario
        If ConsultaRUCREMYPE(ndocumento) = False Then
            MsgBox "Error, revise el número de documento ingresado", vbCritical, "TutorialesExcel.com"
            VelocidadTutorialesExcel.fin
            Exit Sub
        End If
    '----------------------------------
    
    LimpiarIndividual
    
    'Imprimir la información
        n = wConfig.Range("A" & Rows.Count).End(xlUp).Row
    
        c = 6
        For i = 2 To n
            If wConfig.Range("B" & i) = "SI" Then
                wIndividual.Range("C" & c) = wConfig.Range("A" & i)
                wIndividual.Range("D" & c) = ConsultaREMYPE(i - 2)
                c = c + 1
            End If
        Next
    '----------------------------------
    
    MsgBox "Consulta ejecutada correctamente", vbInformation, "TutorialesExcel.com"
    VelocidadTutorialesExcel.fin
End Sub

Sub LimpiarIndividual()
    wIndividual.Range("C6", "C" & Rows.Count).EntireRow.Delete
End Sub

Y de manera similar, el código de consulta y limpieza masiva será:

Sub ConsultaMasiva()
    On Error Resume Next
    Dim ndocumento$, i&, n&, c As Byte, m&, j&
    
    VelocidadTutorialesExcel.inicio
    
    LimpiarMasiva
    
    'Agregar los encabezados
        n = wConfig.Range("A1").CurrentRegion.Rows.Count
        c = 2
        For i = 2 To n
            If wConfig.Range("B" & i) = "SI" Then
                wMasiva.Cells(3, c) = wConfig.Range("A" & i)
                c = c + 1
            End If
        Next
    '----------------------------------
    
    'Recorrer el listado de nRuc
        n = wMasiva.Range("A" & Rows.Count).End(xlUp).Row
        
        For i = 4 To n
            Application.StatusBar = "Consultando " & i - 3 & " de " & n - 3
            ndocumento = wMasiva.Range("A" & i)
            'Validar y calcular lo necesario
                If ConsultaRUCREMYPE(ndocumento) = False Then
                    GoTo LuisRojas
                End If
            '----------------------------------
            
            'Imprimir la información
                m = wConfig.Range("A" & Rows.Count).End(xlUp).Row
                c = 2
                For j = 2 To m
                    If wConfig.Range("B" & j) = "SI" Then
                        wMasiva.Cells(i, c) = ConsultaREMYPE(j - 2)
                        c = c + 1
                    End If
                Next
            '----------------------------------
            
LuisRojas:
            
        Next
    '----------------------------------
    
    Application.StatusBar = False
    VelocidadTutorialesExcel.fin
    
    MsgBox "Proceso terminado", vbInformation, "TutorialesExcel.com"
End Sub

Sub LimpiarMasiva()
    wMasiva.Range(wMasiva.Cells(3, 2), wMasiva.Cells(Rows.Count, Columns.Count)).ClearContents
End Sub

Ambos trabajarían con nuestras macros de velocidad

Sub inicio()
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
End Sub

Sub fin()
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Paso 4: Puesta en marcha del aplicativo

Muy bien, ahora sólo falta ejecutarlo

Descargar Consulta RUC REMYPE

Y listo, espero te haya gustado la publicación, cualquier comentario y/o sugerencia la puedes dejar

Y recuerden que ya tenemos grupo de Whatsapp, puedes unirte en el siguiente enlace

Si deseas aprender a programar desde cero, puedes inscribirte en mi curso