none
Código para pesquisar domínio e descobrir o CNPJ na Web RRS feed

  • Pergunta

  • Pessoal não sou muito bom de VBA, gostaria da ajuda de vocês.

    Tenho uma planilha com vários domínios de páginas, gostaria de automatizar essa busca.

    O site que pesquiso é esse: https://registro.br/

    Resumindo:

    Pego o domínio na plan1, colo e pesquiso, pego a resposta e colo na planilha.

    Por favor me ajudem!!!!

    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 ln              As Long

    Set W = Planilha1

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

    Set Ie = CreateObject("InternetExplorer.Application")
    Set UltCel = W.Cells(W.Rows.Count, 1).End(xlUp)

    With Ie
        .navigate "https://registro.br/tecnologia/ferramentas/whois/"
        .Visible = True
    End With

    Do While Ie.busy
    Loop

    ln = 2
    col = 1

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

    Do While ln <= UltCel.Row

        Ie.Document.getElementaByID("whois-field").getElementaByTagName("span")(0).innertext
        Ie.Document.getelementById("Pesquisar").Click

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

        On Error Resume Next
            vErro = Ie.Document.getelementById("mensagem").innertext

        On Error GoTo 0

        If vErro = "#Erro: Tente novamente! " Then
            Ie.Document.getelementById("consultar").Click
            Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 5)
        ElseIf vErro = "Informe um termo válido! " 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")(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

        End If

        ln = ln + 1
        Ie.Document.getelementById("btnVoltar").Click

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

    Loop

    Ie.Quit

    W.UsedRange.EntireColumn.AutoFit

    Application.ScreenUpdating = True

    DoEvents
    MsgBox "Consulta realizada com sucesso!"


    End Sub




                                                                    
    quinta-feira, 3 de dezembro de 2020 16:36