Busca na internet


#1

Olá pessoal!
Preciso que no momento em que eu coloque o CNPJ da empresa na Célula, o Excel busque no site da receita federal todos os dados da empresa como Razão, Fantasia, Incrição estadual Etc, e já preencha automaticamente.

Sem%20t%C3%ADtulo


#2

@Willian, veja se consegue adaptar ao seu problema:

Sub BuscaCNPJ()

' Cria instância do Internet Explorer
Dim objIE As InternetExplorer
Set objIE = CreateObject("InternetExplorer.Application")

' Cria variáveis auxiliares
Dim elem, tbl, tr

' Desliga atualização de tela
Application.ScreenUpdating = False

    With objIE
         .StatusBar = False
         .Toolbar = False
         .Resizable = False
         .AddressBar = False
         .Visible = True
         
         ' Navega para a página de consulta e aguarda o envio das informações pelo usuário (captcha)
         .Navigate "http://www.receita.fazenda.gov.br/PessoaJuridica/CNPJ/cnpjreva/Cnpjreva_Solicitacao2.asp"
         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
         .Document.all.Item("cnpj").innerText = Planilha1.Cells(1, 2).Value2
         Do While objIE.ReadyState = 4: DoEvents: Loop
         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
        
        ' PEga os dados da consulta
        For Each tr In .Document.getElementsByTagName("tr")
        
            ' Pega razão social
            If InStr(tr.innerText, "NOME EMPRESARIAL") > 0 Then
                Planilha1.Cells(3, 2).Value2 = Trim(Right(tr.innerText, Len(tr.innerText) - Len("NOME EMPRESARIAL ")))
            End If
            
            ' Pega o nome fantasia
            If InStr(tr.innerText, "NOME DE FANTASIA") > 0 Then
                Planilha1.Cells(4, 2).Value2 = Trim(Mid(tr.innerText, InStr(tr.innerText, "NOME DE FANTASIA") + 17, _
                    InStr(tr.innerText, "PORTE") - (InStr(tr.innerText, "NOME DE FANTASIA") + 17)))
            End If
            
            ' Pega o endereço
            If InStr(tr.innerText, "LOGRADOURO") > 0 Then
                Planilha1.Cells(6, 2).Value2 = Trim(Right(tr.innerText, Len(tr.innerText) - 11))
            End If
            
            ' Pega a data de abertura
            If InStr(tr.innerText, "DATA DE ABERTURA") > 0 Then
                Planilha1.Cells(8, 2).Value2 = Trim(Right(tr.innerText, 12))
            End If
            
            ' Pega o telefone
            If InStr(tr.innerText, "TELEFONE") > 0 Then
                Planilha1.Cells(7, 2).Value2 = Trim(Right(tr.innerText, Len(tr.innerText) - (InStr(tr.innerText, "TELEFONE") + 9)))
            End If
            
            ' Pega o e-mail
            If InStr(tr.innerText, "ENDEREÇO ELETRÔNICO") > 0 Then
                Planilha1.Cells(11, 2).Value2 = Trim(Mid(tr.innerText, InStr(tr.innerText, "ENDEREÇO ELETRÔNICO") + 20, _
                    InStr(tr.innerText, "TELEFONE") - (InStr(tr.innerText, "ENDEREÇO ELETRÔNICO") + 20)))
            End If
        Next
    End With
    
    ' Encerra instância do IE
    objIE.Quit
    Set objIE = Nothing

' Liga atualização de tela
Application.ScreenUpdating = True

End Sub