Ir para conteúdo
Fórum Script Brasil
  • 0

Cnpj

Diego.Machado

Perguntado por Diego.Machado,

 Share

Pergunta

11 respostass a esta questão

Posts Recomendados

  • 0
Alyson Ronnan Martins

Alyson Ronnan Martins

Postado
Postado

Passei um tempo fazendo alguns testes, encontrei um site que faz a consulta CNPJ (nunca tinha feito) e estou publicando o código do dentro de um arquivo.

https://1drv.ms/x/s!ArTb7UjY-5CriJFnFdIQOkp_ODgGhw?e=4t42Zh

Segue o código:  

Sub ConsultarCNPJ()
    ' Adcionar a referência Microsoft HTML Object Libary
    Dim IE As Object
    Dim doc As HTMLDocument
    Dim CNPJ As Range
    Dim Status As String

    ' Cria um novo objeto Internet Explorer
    Set IE = CreateObject("InternetExplorer.Application")

    ' Para cada CNPJ na coluna A (de A2 até a última célula preenchida)
    For Each CNPJ In Worksheets("Planilha1").Range("A2:A" & Worksheets("Planilha1").Cells(Rows.Count, 1).End(xlUp).Row)

        ' Navega para o site de consulta de CNPJ
        IE.navigate "https://www.situacao-cadastral.com/"

        ' Aguarda até que a página seja carregada
        Do While IE.Busy Or IE.readyState <> 4
            Application.Wait DateAdd("s", 1, Now)
        Loop

        ' Insere o CNPJ no campo de pesquisa e clica no botão de pesquisa
        Set doc = IE.document
        doc.getElementById("doc").Value = CNPJ.Value
        doc.getElementById("consultar").Click

        ' Aguarda até que a página com os resultados seja carregada
        Do While IE.Busy Or IE.readyState <> 4
            Application.Wait DateAdd("s", 1, Now)
        Loop

        ' Extrai o status do CNPJ e escreve na coluna B
        Set doc = IE.document
        Status = doc.getElementsByClassName("vrd")(0).innerText
        CNPJ.Offset(0, 1).Value = Status

    Next CNPJ

    ' Fecha o Internet Explorer
    IE.Quit

End Sub

 

Link para o comentário
Compartilhar em outros sites
  • 0
Diego.Machado

Diego.Machado

Postado
  • Autor
Postado
3 horas atrás, Alyson Ronnan Martins disse:

Passei um tempo fazendo alguns testes, encontrei um site que faz a consulta CNPJ (nunca tinha feito) e estou publicando o código do dentro de um arquivo.

https://1drv.ms/x/s!ArTb7UjY-5CriJFnFdIQOkp_ODgGhw?e=4t42Zh

Segue o código:  

Sub ConsultarCNPJ()
    ' Adcionar a referência Microsoft HTML Object Libary
    Dim IE As Object
    Dim doc As HTMLDocument
    Dim CNPJ As Range
    Dim Status As String

    ' Cria um novo objeto Internet Explorer
    Set IE = CreateObject("InternetExplorer.Application")

    ' Para cada CNPJ na coluna A (de A2 até a última célula preenchida)
    For Each CNPJ In Worksheets("Planilha1").Range("A2:A" & Worksheets("Planilha1").Cells(Rows.Count, 1).End(xlUp).Row)

        ' Navega para o site de consulta de CNPJ
        IE.navigate "https://www.situacao-cadastral.com/"

        ' Aguarda até que a página seja carregada
        Do While IE.Busy Or IE.readyState <> 4
            Application.Wait DateAdd("s", 1, Now)
        Loop

        ' Insere o CNPJ no campo de pesquisa e clica no botão de pesquisa
        Set doc = IE.document
        doc.getElementById("doc").Value = CNPJ.Value
        doc.getElementById("consultar").Click

        ' Aguarda até que a página com os resultados seja carregada
        Do While IE.Busy Or IE.readyState <> 4
            Application.Wait DateAdd("s", 1, Now)
        Loop

        ' Extrai o status do CNPJ e escreve na coluna B
        Set doc = IE.document
        Status = doc.getElementsByClassName("vrd")(0).innerText
        CNPJ.Offset(0, 1).Value = Status

    Next CNPJ

    ' Fecha o Internet Explorer
    IE.Quit

End Sub

Muito obrigado eu irei testar e te falo se funcionou esse código já está em loop de pegar o primeiro CNPJ depois pegar o da linha de baixo assim em diante? 

Link para o comentário
Compartilhar em outros sites
  • 0
Diego.Machado

Diego.Machado

Postado
  • Autor
Postado
18 horas atrás, Alyson Ronnan Martins disse:

Fiquei com a duvida sobre o que comentou e coloquei um contador para verificar o "loop" e não encontrei, apesar do site que coloquei se um pouco lento para retornar a informação.
Tenho total certeza que fazer isso em Python vai ser muito mais eficiente e rápido.

image.thumb.png.202e37cffd423bedcde2bcc56ed60d64.png

@Diego.Machado

Quando eu tento executar da esse erro image.thumb.png.e1654e5f57b58ee75c827bc7ddc1c2ff.png

13 minutos atrás, Diego.Machado disse:

Quando eu tento executar da esse erro image.thumb.png.e1654e5f57b58ee75c827bc7ddc1c2ff.png

E quando deixo essas linhas do código como texto acrescentando o ' antes de cada uma delas da um erro 91imagem_2023-11-02_142041336.thumb.png.1ce1da790e6eb53f9c9de5443c64fe54.png

Link para o comentário
Compartilhar em outros sites
  • 0
Alyson Ronnan Martins

Alyson Ronnan Martins

Postado
Postado

Boa tarde @Diego.Machado.

Fiz uma revisão no código e parou o erro aqui para mim.

Faz o teste ai nele:
Consultar Status do CNPJ.xlsm 

Sub ConsultarCNPJ()
    ' Adicionar a referência Microsoft HTML Object Library
    Dim IE As Object
    Dim doc As HTMLDocument
    Dim CNPJ As Range
    Dim Status As String
    Dim countLoop As Long

    ' Criar um novo objeto Internet Explorer
    Set IE = CreateObject("InternetExplorer.Application")

    ' Para cada CNPJ na coluna A (de A2 até a última célula preenchida)
    For Each CNPJ In Worksheets("Planilha1").Range("A2:A" & Worksheets("Planilha1").Cells(Rows.Count, 1).End(xlUp).Row)
        countLoop = countLoop + 1
        Debug.Print countLoop

        ' Navegar para o site de consulta de CNPJ
        IE.navigate "https://www.situacao-cadastral.com/"

        ' Aguardar até que a página seja carregada
        Do While IE.Busy Or IE.readyState <> 4
            DoEvents
        Loop

        ' Inserir o CNPJ no campo de pesquisa e clicar no botão de pesquisa
        Set doc = IE.document
        doc.getElementById("doc").Value = CNPJ.Value
        doc.getElementById("consultar").Click

        ' Aguardar até que a página com os resultados seja carregada
        Do While IE.Busy Or IE.readyState <> 4
            DoEvents
        Loop

        ' Extrair o status do CNPJ e escrever na coluna B
        Set doc = IE.document
        Status = doc.getElementsByClassName("vrd")(0).innerText
        CNPJ.Offset(0, 1).Value = Status

        Debug.Print "O CNPJ " & CNPJ.Value & " foi consultado."

    Next CNPJ

    ' Fechar o Internet Explorer
    IE.Quit
End Sub

 

Link para o comentário
Compartilhar em outros sites
  • 0
Diego.Machado

Diego.Machado

Postado
  • Autor
Postado
18 horas atrás, Alyson Ronnan Martins disse:

Boa tarde @Diego.Machado.

Fiz uma revisão no código e parou o erro aqui para mim.

Faz o teste ai nele:
Consultar Status do CNPJ.xlsm 

Sub ConsultarCNPJ()
    ' Adicionar a referência Microsoft HTML Object Library
    Dim IE As Object
    Dim doc As HTMLDocument
    Dim CNPJ As Range
    Dim Status As String
    Dim countLoop As Long

    ' Criar um novo objeto Internet Explorer
    Set IE = CreateObject("InternetExplorer.Application")

    ' Para cada CNPJ na coluna A (de A2 até a última célula preenchida)
    For Each CNPJ In Worksheets("Planilha1").Range("A2:A" & Worksheets("Planilha1").Cells(Rows.Count, 1).End(xlUp).Row)
        countLoop = countLoop + 1
        Debug.Print countLoop

        ' Navegar para o site de consulta de CNPJ
        IE.navigate "https://www.situacao-cadastral.com/"

        ' Aguardar até que a página seja carregada
        Do While IE.Busy Or IE.readyState <> 4
            DoEvents
        Loop

        ' Inserir o CNPJ no campo de pesquisa e clicar no botão de pesquisa
        Set doc = IE.document
        doc.getElementById("doc").Value = CNPJ.Value
        doc.getElementById("consultar").Click

        ' Aguardar até que a página com os resultados seja carregada
        Do While IE.Busy Or IE.readyState <> 4
            DoEvents
        Loop

        ' Extrair o status do CNPJ e escrever na coluna B
        Set doc = IE.document
        Status = doc.getElementsByClassName("vrd")(0).innerText
        CNPJ.Offset(0, 1).Value = Status

        Debug.Print "O CNPJ " & CNPJ.Value & " foi consultado."

    Next CNPJ

    ' Fechar o Internet Explorer
    IE.Quit
End Sub

 

Continua dando o  erro 91 

Porem quando eu faço um teste no console do edge da esse erro como amostra na imagem anexada quando troco os () por [] funciona 

Não sei se pode ser por conta da versão do excel estou usando o 2013 ou alguma opção que tenho que ativar caso precise tenho o selenium e webdriver do chrome e o do edge

image.png.d72e4b43b7fa94837209e3da1a1ea514.png

18 horas atrás, Alyson Ronnan Martins disse:

Boa tarde @Diego.Machado.

Fiz uma revisão no código e parou o erro aqui para mim.

Faz o teste ai nele:
Consultar Status do CNPJ.xlsm 

Sub ConsultarCNPJ()
    ' Adicionar a referência Microsoft HTML Object Library
    Dim IE As Object
    Dim doc As HTMLDocument
    Dim CNPJ As Range
    Dim Status As String
    Dim countLoop As Long

    ' Criar um novo objeto Internet Explorer
    Set IE = CreateObject("InternetExplorer.Application")

    ' Para cada CNPJ na coluna A (de A2 até a última célula preenchida)
    For Each CNPJ In Worksheets("Planilha1").Range("A2:A" & Worksheets("Planilha1").Cells(Rows.Count, 1).End(xlUp).Row)
        countLoop = countLoop + 1
        Debug.Print countLoop

        ' Navegar para o site de consulta de CNPJ
        IE.navigate "https://www.situacao-cadastral.com/"

        ' Aguardar até que a página seja carregada
        Do While IE.Busy Or IE.readyState <> 4
            DoEvents
        Loop

        ' Inserir o CNPJ no campo de pesquisa e clicar no botão de pesquisa
        Set doc = IE.document
        doc.getElementById("doc").Value = CNPJ.Value
        doc.getElementById("consultar").Click

        ' Aguardar até que a página com os resultados seja carregada
        Do While IE.Busy Or IE.readyState <> 4
            DoEvents
        Loop

        ' Extrair o status do CNPJ e escrever na coluna B
        Set doc = IE.document
        Status = doc.getElementsByClassName("vrd")(0).innerText
        CNPJ.Offset(0, 1).Value = Status

        Debug.Print "O CNPJ " & CNPJ.Value & " foi consultado."

    Next CNPJ

    ' Fechar o Internet Explorer
    IE.Quit
End Sub

 

image.thumb.png.06e5c6a32f23eaedf3eb0b4df0580a21.png

Link para o comentário
Compartilhar em outros sites
  • 0
Diego.Machado

Diego.Machado

Postado
  • Autor
Postado
2 horas atrás, Diego.Machado disse:

Continua dando o  erro 91 

Porem quando eu faço um teste no console do edge da esse erro como amostra na imagem anexada quando troco os () por [] funciona 

Não sei se pode ser por conta da versão do excel estou usando o 2013 ou alguma opção que tenho que ativar caso precise tenho o selenium e webdriver do chrome e o do edge

image.png.d72e4b43b7fa94837209e3da1a1ea514.png

image.thumb.png.06e5c6a32f23eaedf3eb0b4df0580a21.png

Eu estou com esse código se fosse ser mais fácil  teria que mudar ele para invés de IE usar o selenium  

Private Sub btExecuta_Click()

 

Application.ScreenUpdating = False

 

Dim vErro As String

Dim IElocation As String

Dim Resultado(1 To 15) As String

 

Dim vNome As String

Dim vDados As String

Dim vSituacao As String

 

Dim W As Worksheet

 

Dim Ie As Object

 

Dim UltCel As Range

 

Dim A As Integer

Dim col As Integer

Dim vSegundos As Integer

 

Dim ln As Long

 

Set W = Planilha1

 

vSegundos = 3

 

W.Range("A2").Select

W.Range("B2:d1000").Clear

 

W.Range("A1").Value = "num_cpf"

W.Range("b1").Value = "nome_pessoa_física"

W.Range("c1").Value = "situação"

W.Range("d1").Value = "informações complementares"

 

Set Ie = CreateObject("InternetExplorer.Application")

Set UltCel = W.Cells(W.Rows.Count, 1).End(xlUp)

 

With Ie

.navigate "https://www.situacaocadastral.com.br/"

.Visible = True

End With

 

Do While Ie.busy

Loop

 

ln = 2

col = 1

 

Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + vSegundos)

 

Do While ln <= UltCel.Row

 

Ie.Document.getelementbyid("doc").Value = W.Cells(ln, col)

Ie.Document.getelementbyid("consultar").Click

 

Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + vSegundos)

 

On Error Resume Next

vErro = Ie.Document.getelementbyid("mensagem").innertext

 

On Error GoTo 0

 

If vErro = "Informe um termo válido! " Then

Ie.Document.getelementbyid("consultar").Click

Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + vSegundos)

ElseIf vErro = "Informe um termo válido! " Then

W.Cells(ln, col + 1).Value = "'" & vErro

ElseIf Trim(vErro) = "CPF inválido" Then

W.Cells(ln, col + 1).Value = "'" & vErro

ElseIf Trim(vErro) = "#Erro: Tente novamente!" Then

W.Cells(ln, col + 1).Value = "'" & vErro

Else

vErro = vbNullString

End If

 

Do While Ie.busy

Loop

 

If vErro = vbNullString Then

 

vNome = Ie.Document.getelementsbyclassname("dados nome")(0).innertext

vDados = Ie.Document.getelementsbyclassname("dados texto")(0).innertext

vSituacao = Ie.Document.getelementsbyclassname("dados situacao")(0).innertext

 

W.Cells(ln, col + 1) = vNome

W.Cells(ln, col + 2) = vSituacao

W.Cells(ln, col + 3) = vDados

 

vNome = vbNullString

vDados = vbNullString

vSituacao = vbNullString

 

Ie.Document.getelementbyid("btnVoltar").Click

 

Else

 

Ie.navigate "https://www.situacaocadastral.com.br/"

W.Cells(ln, col + 1) = "Dados inválidos para consulta"

 

End If

 

ln = ln + 1

 

Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + vSegundos)

 

Loop

 

Ie.Quit

 

W.UsedRange.EntireColumn.AutoFit

 

Application.ScreenUpdating = True

 

DoEvents

MsgBox "Consulta realizada com sucesso!"

 

Set Ie = Nothing

Set UltCel = Nothing

Set W = Nothing

 

End sub

Link para o comentário
Compartilhar em outros sites
  • 0
Alyson Ronnan Martins

Alyson Ronnan Martins

Postado
Postado
14 minutos atrás, Diego.Machado disse:

Eu estou com esse código se fosse ser mais fácil  teria que mudar ele para invés de IE usar o selenium  

Private Sub btExecuta_Click()

 

Application.ScreenUpdating = False

 

Dim vErro As String

Dim IElocation As String

Dim Resultado(1 To 15) As String

 

Dim vNome As String

Dim vDados As String

Dim vSituacao As String

 

Dim W As Worksheet

 

Dim Ie As Object

 

Dim UltCel As Range

 

Dim A As Integer

Dim col As Integer

Dim vSegundos As Integer

 

Dim ln As Long

 

Set W = Planilha1

 

vSegundos = 3

 

W.Range("A2").Select

W.Range("B2:d1000").Clear

 

W.Range("A1").Value = "num_cpf"

W.Range("b1").Value = "nome_pessoa_física"

W.Range("c1").Value = "situação"

W.Range("d1").Value = "informações complementares"

 

Set Ie = CreateObject("InternetExplorer.Application")

Set UltCel = W.Cells(W.Rows.Count, 1).End(xlUp)

 

With Ie

.navigate "https://www.situacaocadastral.com.br/"

.Visible = True

End With

 

Do While Ie.busy

Loop

 

ln = 2

col = 1

 

Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + vSegundos)

 

Do While ln <= UltCel.Row

 

Ie.Document.getelementbyid("doc").Value = W.Cells(ln, col)

Ie.Document.getelementbyid("consultar").Click

 

Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + vSegundos)

 

On Error Resume Next

vErro = Ie.Document.getelementbyid("mensagem").innertext

 

On Error GoTo 0

 

If vErro = "Informe um termo válido! " Then

Ie.Document.getelementbyid("consultar").Click

Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + vSegundos)

ElseIf vErro = "Informe um termo válido! " Then

W.Cells(ln, col + 1).Value = "'" & vErro

ElseIf Trim(vErro) = "CPF inválido" Then

W.Cells(ln, col + 1).Value = "'" & vErro

ElseIf Trim(vErro) = "#Erro: Tente novamente!" Then

W.Cells(ln, col + 1).Value = "'" & vErro

Else

vErro = vbNullString

End If

 

Do While Ie.busy

Loop

 

If vErro = vbNullString Then

 

vNome = Ie.Document.getelementsbyclassname("dados nome")(0).innertext

vDados = Ie.Document.getelementsbyclassname("dados texto")(0).innertext

vSituacao = Ie.Document.getelementsbyclassname("dados situacao")(0).innertext

 

W.Cells(ln, col + 1) = vNome

W.Cells(ln, col + 2) = vSituacao

W.Cells(ln, col + 3) = vDados

 

vNome = vbNullString

vDados = vbNullString

vSituacao = vbNullString

 

Ie.Document.getelementbyid("btnVoltar").Click

 

Else

 

Ie.navigate "https://www.situacaocadastral.com.br/"

W.Cells(ln, col + 1) = "Dados inválidos para consulta"

 

End If

 

ln = ln + 1

 

Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + vSegundos)

 

Loop

 

Ie.Quit

 

W.UsedRange.EntireColumn.AutoFit

 

Application.ScreenUpdating = True

 

DoEvents

MsgBox "Consulta realizada com sucesso!"

 

Set Ie = Nothing

Set UltCel = Nothing

Set W = Nothing

 

End sub

É uma pergunta?

 

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,5k
×
×
  • Criar Novo...