Blog

¡Un saludo a mi gente linda de Perú! Hoy veremos cómo generar una macro para obtener los Obligados de comprobantes electrónicos desde Excel

Vale sin muchos preámbulos, puedes descargar el aplicativo completamente gratis dando click en la siguiente imagen:

Vale ahora expliquemos el desarrollo y funcionamiento del aplicativo

Página donde se realiza la consulta web

Lo primero que debemos saber es que las consultas se deben hacer a la siguiente web: https://www.sunat.gob.pe/ol-ti-itobligado-consulta/padronObligadosCPE?action=verConsultaComprobanteObligado

Ahora sólo hacemos un pequeño análisis para saber la comunicación entre el front y el back

Y ya tenemos todas las variables y el tipo de envío

Si tú mi querido lector, no cuentas con conocimientos en web, te comento que estoy creando mi curso de Excel VBA Consultas Web desde cero

Ing. Luis Rojas

Desarrollo del código VBA para comunicar Excel con SUNAT

Muy bien, como ya es de costumbre en nuestro blog, primero realizaremos el diseño de nuestras hojas

Vale, y creamos una hoja individual, que desde VBA la renombraremos como wIndividual y un hoja masiva, cuyo nombre desde VBA será wMasiva

El aplicativo nos devolverá 4 campos, los cuales son:

• Razón Social
• Comprobantes obligados
• Base legal
• Fecha de obligación

Por lo que será necesario usar un Array para almacenar esta información

El link de consulta SUNAT se mantendrá constante, por que no es necesario declararlo como variable

Quedando nuestras primeras líneas de instrucción de la siguiente forma:

Public Obligado(3) As String
Const webSUNATObligados As String = "https://ww1.sunat.gob.pe/ol-ti-itobligado-consulta/padronObligadosCPE?action=buscarObligado"

Código VBA que realiza el scraping a la web de SUNAT

Muy bien, como es de costumbre en el blog, usaremos un código con la mentalidad ‘divide y vencerás’, este código será el siguiente:

Function ConsultaObligados(nEnviado As String) As Boolean
    Dim caracteres As Byte, Validador As Boolean, nRuc$
    
    Dim Respuesta$, RespuestaTexto$, RespuestaHTML$, Captcha$, enviado$, Solicitud As Object
    
    'Validación del número de RUC
        caracteres = Len(nEnviado)
        
        Select Case caracteres
            Case 8
                Validador = True
                nRuc = ConvertirDNIaRUC(nEnviado)
            Case 11
                If ValidarRUC(nEnviado) = "Correcto" Then
                    Validador = True
                    nRuc = nEnviado
                Else
                    Validador = False
                End If
                
            Case Else
                Validador = False
        End Select
        
        If Validador = False Then
            ConsultaRUCSunat = False
            Exit Function
        End If
    '--------------------------------
    
    'Realizar consulta a SUNAT
        Set Solicitud = CreateObject("winhttp.winhttprequest.5.1")
        
        enviado = "numeroRuc=" & nEnviado & "&razonSocialRuc="
        Solicitud.Open "POST", webSUNATObligados, False
        Solicitud.setrequestheader "Content-type", "application/x-www-form-urlencoded"
        Solicitud.send (enviado)
        Respuesta = Solicitud.ResponseText
        
    '--------------------------------
    
    'Leer el Respuesta
        If InStr(Respuesta, Chr(34) & "cantidad" & Chr(34) & ":0}") > 0 Then
            ConsultaObligados = False
        Else
            LeerRespuesta Respuesta
            ConsultaObligados = True
        End If
    '--------------------------------
End Function

Sub LeerRespuesta(Resp As String)
    Dim posi%, posf%, Separa$, filas() As String, i As Byte

    posi = InStr(Resp, "[") + 1
    posf = InStr(Resp, "]")
    filas = Split(Mid(Resp, posi, posf - posi), "},{")
    
    Obligado(0) = Empty: Obligado(1) = Empty: Obligado(2) = Empty: Obligado(3) = Empty
    For i = 0 To UBound(filas)
        Separa = ReemplazarCaracteres(filas(i))
        If i = 0 Then
            Obligado(0) = encontrarValor(Separa, "razonSocialRuc", "desCompPago")
            Obligado(1) = encontrarValor(Separa, "desCompPago", "numeroResolucion")
            Obligado(2) = encontrarValor(Separa, "numeroResolucion", "fechaObligacion")
            Obligado(3) = encontrarValor(Separa, "fechaObligacion")
        Else
            Obligado(1) = Obligado(1) & " " & encontrarValor(Separa, "desCompPago", "numeroResolucion")
            Obligado(2) = Obligado(2) & ", " & encontrarValor(Separa, "numeroResolucion", "fechaObligacion")
            Obligado(3) = Obligado(3) & " - " & encontrarValor(Separa, "fechaObligacion")
        End If
    Next
    
End Sub

Function ReemplazarCaracteres(Valor As String) As String
    Dim Valor1$
    
    Valor1 = Replace(Valor, "\", " ")
    Valor1 = Replace(Valor1, "/", " ")
    Valor1 = Replace(Valor1, "u003cbr", "")
    Valor1 = Replace(Valor1, "u003e", ", ")
    Valor1 = Replace(Valor1, ":", " ")
    Valor1 = Replace(Valor1, Chr(34) & ", " & Chr(34), " ")
    Valor1 = Replace(Valor1, Chr(34) & "  " & Chr(34), " ")
    Valor1 = Application.WorksheetFunction.Trim(Valor1)
    Valor1 = Replace(Valor1, " , ", ", ")
    ReemplazarCaracteres = Valor1
End Function

Function encontrarValor(Texto$, Valor1$, Optional Valor2$) As String
    Dim posi%, posf%
    posi = InStr(Texto, Valor1) + Len(Valor1)
    
    If Valor2 = Empty Then
        posf = Len(Texto)
    Else
        posf = InStr(Texto, Valor2)
    End If
    
    encontrarValor = Application.WorksheetFunction.Trim(Replace(Mid(Texto, posi, posf - posi), Chr(34), ""))
End Function

Este bello código ayudará a realizar las consultas individuales y masivas de una forma más limpia y ligera

Código de validación de números de RUC

Muy bien, el código de validación de números de RUC lo copiaremos de una publicación anterior (Leer publicación)

Function ValidarRUC(RUC As String) As String
    Dim Respuesta As String, Temporal As Integer
    On Error GoTo sale
    
    If Len(RUC) <> 11 Then
        Respuesta = "Incorrecto"
    End If
    
    Temporal = Val(Left(RUC, 2))
    If Temporal <> 10 And Temporal <> 20 And Temporal <> 15 And Temporal <> 16 And Temporal <> 17 Then
        Respuesta = "Incorrecto"
    End If
    
    Dim suma As Integer, resto As Integer, complemento As Byte
    suma = Val(Mid(RUC, 1, 1)) * 5 + Val(Mid(RUC, 2, 1)) * 4 + Val(Mid(RUC, 3, 1)) * 3 + Val(Mid(RUC, 4, 1)) * 2 + Val(Mid(RUC, 5, 1)) * 7 + Val(Mid(RUC, 6, 1)) * 6 + Val(Mid(RUC, 7, 1)) * 5 + Val(Mid(RUC, 8, 1)) * 4 + Val(Mid(RUC, 9, 1)) * 3 + Val(Mid(RUC, 10, 1)) * 2
    resto = suma Mod 11
    complemento = IIf(resto = 1, 0, Val(Left(11 - resto, 1)))
    
    If Val(Mid(RUC, 11, 1)) = complemento Then
        ValidarRUC = "Correcto"
        Exit Function
    End If
sale:
    Respuesta = "Incorrecto"
    ValidarRUC = Respuesta
End Function

Function ConvertirDNIaRUC(DNI As String) As String
    If Len(DNI) <> 8 Then
        ConvertirDNIaRUC = "Error en DNI"
        Exit Function
    End If
    
    Dim RUC As String
    
    Dim suma As Integer, resto As Integer, complemento As Byte
    RUC = 10 & DNI
    suma = Val(Mid(RUC, 1, 1)) * 5 + Val(Mid(RUC, 2, 1)) * 4 + Val(Mid(RUC, 3, 1)) * 3 + Val(Mid(RUC, 4, 1)) * 2 + Val(Mid(RUC, 5, 1)) * 7 + Val(Mid(RUC, 6, 1)) * 6 + Val(Mid(RUC, 7, 1)) * 5 + Val(Mid(RUC, 8, 1)) * 4 + Val(Mid(RUC, 9, 1)) * 3 + Val(Mid(RUC, 10, 1)) * 2
    resto = suma Mod 11
    complemento = IIf(resto = 1, 0, Val(Left(11 - resto, 1)))
    
    ConvertirDNIaRUC = "10" & DNI & complemento

End Function

Consulta individual desde VBA

El código que utilizaremos para realizar la consulta y limpieza individual desde VBA sugiero que sea el siguiente:

Sub ConsultaIndividual()
    Dim nRuc$
    With wIndividual
        nRuc = .Range("C3")
        If ConsultaObligados(nRuc) = True Then
            .Range("C5") = Obligado(0)
            .Range("C6") = Obligado(1)
            .Range("C7") = Obligado(2)
            .Range("C8") = Obligado(3)
        Else
            MsgBox "No se encontró información", vbInformation, "TutorialesExcel.com"
        End If
    End With
End Sub

Sub LimpiarIndividual()
    With wIndividual
        .Range("C5:C8") = Empty
    End With
End Sub

Consulta masiva desde VBA

La consulta masiva se realizará utilizando un código similar, el cual trabajará en la hoja wMasiva

Sub ConsultaMasiva()
    Dim i%, n%
    
    With wMasiva
        n = .Range("A" & Rows.Count).End(xlUp).Row
        
        For i = 4 To n
            If ConsultaObligados(.Range("A" & i)) = True Then
                .Range("B" & i) = Obligado(0)
                .Range("C" & i) = Obligado(1)
                .Range("D" & i) = Obligado(2)
                .Range("E" & i) = Obligado(3)
            End If
        Next
    End With
End Sub

Sub LimpiarMasiva()
    Dim i%
    With wMasiva
        i = wMasiva.Range("E" & Rows.Count).End(xlUp).Row
        i = IIf(i = 3, 4, i)
        .Range("B4:C" & i) = Empty
    End With
End Sub

Y con estos códigos ya podemos realizar la consulta masiva desde VBA para obtener los Obligados de comprobantes electrónicos desde Excel

Muy bien, y hemos terminado, este ha sido un desarrollo muy pequeñito

No olvides que tenemos grupo de Whatsapp y Facebook

Descargar Obligados de comprobantes electrónicos desde Excel