Home » » Consulta de datos SUNAT por RUC - VisuaI Basic 6.0

Consulta de datos SUNAT por RUC - VisuaI Basic 6.0


LES DEJO EL CODIGO PARA CONSULTAR RUC DE LA SUNAT

AQUI LES DEJO EL CODIGO VISUAL BASIC 6.0


' NO OLVIDEN REFERENCIAS --> a Microsoft XML v2.6 ACTIVEN EL CHECK

Option Explicit
Dim xDat As String
Dim xRazSoc As String, xEst As String, xCon As String, xDir As String
Dim xRazSocX As Long, xEstX As Long, xConX As Long, xDirX As Long
Dim xRazSocY As Long, xEstY As Long, xConY As Long, xDirY As Long
Private Sub btnCon_Click()
    If Trim(txtRuc.Text) = "" Then
        MsgBox "Ingrese número del RUC"
        txtRuc.SetFocus
        Exit Sub
    End If
    If IsNumeric(txtRuc.Text) = True Then
        If Len(txtRuc.Text) < 11 Then
            Limpiar
            MsgBox "Ingrese los 11 números del RUC"
            txtRuc.SetFocus
            Exit Sub
        End If
        If Val(Mid(Trim(txtRuc.Text), 2, 9)) = 0 Or Trim(txtRuc.Text) = "23333333333" Then
            Limpiar
            MsgBox "Verificar número del RUC"
            txtRuc.SetFocus
            Exit Sub
        End If
        If Verificar_ruc(txtRuc.Text) = False Then
            Limpiar
            MsgBox "El número del RUC no es válido"
            txtRuc.SetFocus
            Exit Sub
        End If
'        RUC txtRuc.Text
        OTRO txtRuc.Text
    Else
        Limpiar
        MsgBox "Solo se aceptan números"
        txtRuc.SetFocus
    End If
End Sub
Private Sub RUC(ByVal xNum As String)
 On Error Resume Next
    Dim xWml As New XMLHTTP
    xWml.open "POST", "http://www.sunat.gob.pe/w/wapS01Alias?ruc=" & xNum, False
    xWml.send
    If xWml.Status = 200 Then
        Limpiar
        xDat = xWml.responseText
        If Len(xDat) <= 635 Then
            Habilitar False
            MsgBox "El numero Ruc ingresado no existe en la Base de datos de la SUNAT"
            Set xWml = Nothing
            txtRuc.SetFocus
            Exit Sub
        End If
        Habilitar True
        xDat = Replace(xDat, "N&#xFA;mero Ruc. </b> " & xNum & " - ", "RazonSocial:")
        xDat = Replace(xDat, "Estado.</b>", "Estado:")
        xDat = Replace(xDat, "Agente Retenci&#xF3;n IGV.", "ARIGV:")
        xDat = Replace(xDat, "Situaci&#xF3;n.<b> ", "Situacion:")
        xDat = Replace(xDat, "Direcci&#xF3;n.</b><br/>", "Direccion:")
        xDat = Replace(xDat, "     ", " ")
        xDat = Replace(xDat, "    ", " ")
        xDat = Replace(xDat, "   ", " ")
        xDat = Replace(xDat, "  ", " ")
        xDat = Replace(xDat, "( ", "(")
        xDat = Replace(xDat, " )", ")")
       
        xRazSocX = InStr(1, xDat, "RazonSocial:", vbTextCompare)
            xRazSocY = InStr(1, xDat, " <br/></small>", vbTextCompare)
            xRazSocX = xRazSocX + 12
        xRazSoc = Mid(xDat, xRazSocX, (xRazSocY - xRazSocX))

        xEstX = InStr(1, xDat, "Estado:", vbTextCompare)
            xEstY = InStr(1, xDat, "ARIGV:", vbTextCompare)
            xEstX = xEstX + 7
        xEst = Mid(xDat, xEstX, ((xEstY - 34) - xEstX))
       
        xConX = InStr(1, xDat, "Situacion:", vbTextCompare)
            xConY = InStr(1, xDat, "</b></small><br/>", vbTextCompare)
            xDirY = xConX - 23
            xConX = xConX + 10
        xCon = Mid(xDat, xConX, (xConY - xConX))
   
        xDirX = InStr(1, xDat, "Direccion:", vbTextCompare)
            xDirX = xDirX + 10
        xDir = Mid(xDat, xDirX, (xDirY - xDirX))
       
        xRazSoc = Replace(xRazSoc, "&#209;", "Ñ")
        xRazSoc = Replace(xRazSoc, "&#xD1;", "Ñ")
        xRazSoc = Replace(xRazSoc, "&#193;", "Á")
        xRazSoc = Replace(xRazSoc, "&#201;", "É")
        xRazSoc = Replace(xRazSoc, "&#205;", "Í")
        xRazSoc = Replace(xRazSoc, "&#211;", "Ó")
        xRazSoc = Replace(xRazSoc, "&#218;", "Ú")
        xRazSoc = Replace(xRazSoc, "&#xC1;", "Á")
        xRazSoc = Replace(xRazSoc, "&#xC9;", "É")
        xRazSoc = Replace(xRazSoc, "&#xCD;", "Í")
        xRazSoc = Replace(xRazSoc, "&#xD3;", "Ó")
        xRazSoc = Replace(xRazSoc, "&#xDA;", "Ú")
       
        xDir = Replace(xDir, "&#209;", "Ñ")
        xDir = Replace(xDir, "&#xD1;", "Ñ")
        xDir = Replace(xDir, "&#193;", "Á")
        xDir = Replace(xDir, "&#201;", "É")
        xDir = Replace(xDir, "&#205;", "Í")
        xDir = Replace(xDir, "&#211;", "Ó")
        xDir = Replace(xDir, "&#218;", "Ú")
        xDir = Replace(xDir, "&#xC1;", "Á")
        xDir = Replace(xDir, "&#xC9;", "É")
        xDir = Replace(xDir, "&#xCD;", "Í")
        xDir = Replace(xDir, "&#xD3;", "Ó")
        xDir = Replace(xDir, "&#xDA;", "Ú")
       
        txtRazSoc.Text = xRazSoc
        txtEst.Text = xEst
        txtCon.Text = xCon
        txtDir.Text = xDir
    Else
        Habilitar False
        Limpiar
        MsgBox "No responde el servicio de la SUNAT"
    End If
    Set xWml = Nothing
End Sub
Private Sub OTRO(ByVal xNum As String)
On Error Resume Next
    Dim xWml As New XMLHTTP
    xWml.open "POST", "http://www.sunat.gob.pe/w/wapS01Alias?ruc=" & xNum, False
    xWml.send
    If xWml.Status = 200 Then
        Limpiar
        xDat = xWml.responseText
        If Len(xDat) <= 635 Then
            Habilitar False
            MsgBox "El numero Ruc ingresado no existe en la Base de datos de la SUNAT"
            Set xWml = Nothing
            txtRuc.SetFocus
            Exit Sub
        End If
        Habilitar True
        Dim xTabla() As String
       
        xDat = Replace(xDat, "     ", " ")
        xDat = Replace(xDat, "    ", " ")
        xDat = Replace(xDat, "   ", " ")
        xDat = Replace(xDat, "  ", " ")
        xDat = Replace(xDat, "( ", "(")
        xDat = Replace(xDat, " )", ")")
       
        xTabla = Split(xDat, "<small>")
     
        xTabla(1) = Replace(xTabla(1), "<b>N&#xFA;mero Ruc. </b> " & xNum & " - ", "")
        xTabla(1) = Replace(xTabla(1), " <br/></small>", "")
       
        xTabla(4) = Replace(xTabla(4), "<b>Estado.</b>", "")
        xTabla(4) = Replace(xTabla(4), "</small><br/>", "")
       
        xTabla(7) = Replace(xTabla(7), "<b>Direcci&#xF3;n.</b><br/>", "")
        xTabla(7) = Replace(xTabla(7), "</small><br/>", "")
       
        xTabla(8) = Replace(xTabla(8), "Situaci&#xF3;n.<b> ", "")
        xTabla(8) = Replace(xTabla(8), "</b></small><br/>", "")
       
        xRazSoc = CStr(xTabla(1))
        xEst = CStr(xTabla(4))
        xDir = CStr(xTabla(7))
        xCon = CStr(xTabla(8))
       
        xRazSoc = Replace(xRazSoc, "&#209;", "Ñ")
        xRazSoc = Replace(xRazSoc, "&#xD1;", "Ñ")
        xRazSoc = Replace(xRazSoc, "&#193;", "Á")
        xRazSoc = Replace(xRazSoc, "&#201;", "É")
        xRazSoc = Replace(xRazSoc, "&#205;", "Í")
        xRazSoc = Replace(xRazSoc, "&#211;", "Ó")
        xRazSoc = Replace(xRazSoc, "&#218;", "Ú")
        xRazSoc = Replace(xRazSoc, "&#xC1;", "Á")
        xRazSoc = Replace(xRazSoc, "&#xC9;", "É")
        xRazSoc = Replace(xRazSoc, "&#xCD;", "Í")
        xRazSoc = Replace(xRazSoc, "&#xD3;", "Ó")
        xRazSoc = Replace(xRazSoc, "&#xDA;", "Ú")
       
        xRazSoc = Mid(xRazSoc, 1, Len(xRazSoc) - 3)
       
        xDir = Replace(xDir, "&#209;", "Ñ")
        xDir = Replace(xDir, "&#xD1;", "Ñ")
        xDir = Replace(xDir, "&#193;", "Á")
        xDir = Replace(xDir, "&#201;", "É")
        xDir = Replace(xDir, "&#205;", "Í")
        xDir = Replace(xDir, "&#211;", "Ó")
        xDir = Replace(xDir, "&#218;", "Ú")
        xDir = Replace(xDir, "&#xC1;", "Á")
        xDir = Replace(xDir, "&#xC9;", "É")
        xDir = Replace(xDir, "&#xCD;", "Í")
        xDir = Replace(xDir, "&#xD3;", "Ó")
        xDir = Replace(xDir, "&#xDA;", "Ú")
       
        xEst = Mid(xEst, 1, Len(xEst) - 6)
        xCon = Mid(xCon, 1, Len(xCon) - 3)
        xDir = Mid(xDir, 1, Len(xDir) - 3)
       
        txtRazSoc.Text = xRazSoc
        txtEst.Text = xEst
        txtCon.Text = xCon
        txtDir.Text = xDir
    Else
        Habilitar False
        Limpiar
        MsgBox "No responde el servicio de la SUNAT"
    End If
    Set xWml = Nothing
End Sub
Private Sub Limpiar()
    xRazSoc = ""
    xEst = ""
    xCon = ""
    xDir = ""
    txtRazSoc.Text = ""
    txtEst.Text = ""
    txtCon.Text = ""
    txtDir.Text = ""
End Sub
Private Sub Habilitar(ByVal xOpc As Boolean)
    lbl2.Visible = xOpc
    lbl3.Visible = xOpc
    lbl4.Visible = xOpc
    lbl5.Visible = xOpc
    txtRazSoc.Visible = xOpc
    txtEst.Visible = xOpc
    txtCon.Visible = xOpc
    txtDir.Visible = xOpc
End Sub
Private Sub Form_Load()
    Habilitar False
End Sub
Function Verificar_ruc(ByVal xNum As String) As Boolean
    Dim li_suma, li_residuo, li_diferencia, li_compara As Integer
    li_suma = (CInt(Mid(xNum, 1, 1)) * 5) + (CInt(Mid(xNum, 2, 1)) * 4) + (CInt(Mid(xNum, 3, 1)) * 3) + (CInt(Mid(xNum, 4, 1)) * 2) + (CInt(Mid(xNum, 5, 1)) * 7) + (CInt(Mid(xNum, 6, 1)) * 6) + (CInt(Mid(xNum, 7, 1)) * 5) + (CInt(Mid(xNum, 8, 1)) * 4) + (CInt(Mid(xNum, 9, 1)) * 3) + (CInt(Mid(xNum, 10, 1)) * 2)
    li_compara = CInt(Mid(xNum, 11, 1))
    li_residuo = li_suma Mod 11
    li_diferencia = Int(11 - li_residuo)
    If li_diferencia > 9 Then li_diferencia = li_diferencia - 10
    If li_diferencia <> li_compara Then
        Verificar_ruc = False
    Else
        Verificar_ruc = True
    End If
End Function

SI TIENEN DUDAS NO DUDEN EN CONSULTAR

ESPERO COMENTARIOS

25 comentarios:

  1. Buen aporte amigo sube el programa para descargarlo

    ResponderEliminar
    Respuestas
    1. TENDRAS UN CODIGO SIMILAR PARA LA CONSULTA DEL DNI

      Eliminar
  2. Lo quisiera en C#
    Muchas gracias!
    mi correo c_leviss@hotmail.com

    ResponderEliminar
    Respuestas
    1. que pendejo, tu hazlo ps

      Eliminar
    2. Y encima quiere que le envíe a su correo.. tremendo HOYGAN!

      Eliminar
    3. de donde sacaste el código de consulta de sunat que esta genial yo tengo el de reniec podemos intercambiar 990441903

      Eliminar
    4. He programado una .Dll para haga ese trabajo , lo que hace es tan solo con poner el DNI (PERU) calcula el RUC y lo busca en SUNAT y si no esta registrado ese ruc lo busco en RENIEC osea si o si tienes el nombre o razón social de esa persona y como es sabido si pones el RUC lo hubica automáticamente en sunat y extrayendo toda su información incluyendo si tiene deuda tributaria y sucursales

      Eliminar
  3. Hola amigos este es mi blog en C SHARP ahi lo subire para Abril ahora estoy con mucha chamba espero sepan esperarme un poquito http://lpcsharp.blogspot.com

    ResponderEliminar
    Respuestas
    1. de donde sacaste el código de consulta de sunat que esta genial yo tengo el de reniec podemos intercvambiar

      Eliminar
  4. como seria la consulta de los datos por numero de DNI. Gracias

    ResponderEliminar
  5. Muy buena aplicación!, gracias. nos será de mucha ayuda.

    ResponderEliminar
  6. ya no funca porque la sunat esta haciendo cambios para el sistema movil. Ahora ha buscar otro hueco en el sistema

    ResponderEliminar
    Respuestas
    1. Justo hoy que estaba haciendo un dmeo no funciona

      Eliminar
  7. http://www.perucontable.com/modules/newbb/viewtopic.php?post_id=83920#.UhzzhdJWySo

    ResponderEliminar
  8. Para los que son programadores pueden revisar este resultado: Se puede observar que los datos se obtienen de "ejecutar" este enlace en internet.

    http://www.sunat.gob.pe/w/wapS01Alias?ruc=XXXMIRUC

    Reemplacemos XXXMIRUC por el ruc deseado y nos retornará un archivo XML con los datos.

    Saludos.

    ResponderEliminar
    Respuestas
    1. Interesante, si si cambiamos los alias? y probamos buscar por Razon Social

      Eliminar
    2. prueben mi aplicacion :D
      Gracias a tu Info
      www.datatiendas.com/ruc

      Eliminar
  9. sigan este hilo
    http://leandroascierto.com/foro/index.php?topic=1619.0

    ResponderEliminar
  10. Aqui bajaran la aplicacion para SUNAT y PARA BUSCAR DNI
    https://www.facebook.com/CJSystem

    ResponderEliminar
  11. Buenos dias muy interesante esta ayuda quisiera ver si porfavor podrias porfavor indicarme que controles tengo que agregar al formulario para que pueda funcionar correctamente

    ResponderEliminar
  12. puede agregar otros campos como estado activo o inactivo

    ResponderEliminar
  13. la idea de esto software es que se pueda implementar en cualquier software y no solo consultar en un ejecutable externo...

    ResponderEliminar
  14. Hola amigo que tal, bueno quería preguntarte si tienes el codigo para PHP, ya que lo necesito y no se como extraer los datos, haber te agradeceria si me echas una mano.

    ResponderEliminar

Con la tecnología de Blogger.