Consulta RUC SRI Ecuador desde Excel

Un saludo desde Perú a mi gente linda de Ecuador. Hoy veremos el aplicativo Consulta RUC SRI Ecuador desde Excel

Primero agradecerles a los miembros del grupo de Whatsapp de TutorialesExcel.com por compartir tantos archivos y experiencias

Vale, primero informarles que este aplicativo es gratuito y lo puedes descargar desde el siguiente enlace

Ahora procederé a explicarles la programación y el funcionamiento del mismo

Paso 1: Diseño del aplicativo de Consulta RUC Ecuador

Primero debemos elaborar el diseño del aplicativo, y lo hice similar al aplicativo de Consulta RUC Perú

Tenemos tres hojas:

Hoja de consultas individuales
Hoja de consultas masivas
Hoja de configuración de campos a buscar

Paso 2: Programación de la función para realizar consultas

El segundo paso, es realizar el código principal de la función que nos devolverá los campos que necesitamos

La web de consulta para este ejemplo será Consulta SRI Ecuador a la cual le enviaremos un valor de un RUC a través de GET

Como vamos a trabajar con 13 campos, usaremos un array para los valores devueltos, y una constante para almacenar el link de consulta

Además debemos considerar que es mejor para este caso convertir el HTML devuelto a texto, de ese modo será más sencillo realizar la limpieza

Function ConsultaRUCSRI(nEnviado As String) As Boolean
    Dim Respuesta$, RespuestaTexto$, enviado$
    Dim Solicitud As Object
    
    Dim HTML As Object
    
    Dim i As Byte, n As Byte
    
    Set Solicitud = CreateObject("winhttp.winhttprequest.5.1")
    'Consulta Datos a web Consulta RUC
        enviado = ""
        Solicitud.Open "POST", webSRI & nEnviado, False
        Solicitud.setrequestheader "Content-type", "application/x-www-form-urlencoded"
        Solicitud.send (enviado)
        Respuesta = Solicitud.responsetext
    '--------------------------------
    
    'Limpiar el HTML de la respuesta
        Set HTML = CreateObject("HTMLFILE")
        HTML.body.innerHTML = Respuesta
        RespuestaTexto = HTML.body.innerText
    '--------------------------------
    
    'Validar
        If InStr(RespuestaTexto, "error inesperado") > 0 Then
            ConsultaRUCSRI = False
            Exit Function
        End If
    '--------------------------------
    
    'Limpiar array
        n = wConfig.Range("A1").CurrentRegion.Rows.Count
        For i = 2 To n
            ConsultaSRI(i - 2) = Empty
        Next
    '--------------------------------
    
    'Obtener la data requerida
        For i = 2 To n
            If wConfig.Range("B" & i) = "SI" Then
                ConsultaSRI(i - 2) = limpiarRespuesta(RespuestaTexto, wConfig.Range("A" & i), wConfig.Range("A" & i + 1))
            End If
        Next
    '--------------------------------
    
    ConsultaRUCSRI = True
End Function

La limpieza de la respuesta y asignación de valores al array lo haremos con la siguiente función

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 = "Establecimientos registrados"
    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

Paso 3: Programación de macros de consultas individuales y masivas

Esta parte es sencilla, solo usaremos un código que use a nuestra función creada en el paso 2

Para la consulta y limpieza individual usaremos:

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 ConsultaRUCSRI(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) = ConsultaSRI(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 para la masiva

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 ConsultaRUCSRI(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) = ConsultaSRI(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

Por supuesto, en ambos casos debemos utilizar nuestro código 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