¡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
Excelente aporte, el año pasado yo creé un código con la misma función, aun no se trabajar del todo bien con VBA así que algunos pasos los debo hacer algo largos para tener un resultado final.
Tu aporte me ayudará mucho a mejorar mi conocimiento. Muchas gracias.
Gracias por tu mensajes y por ser seguidor de la página 😀