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

  • Pergunta

  • Pessoal me ajudem, não sou um expert em VBA.

    Tenho uma planilha com vários domínios e quero descobrir a quem pertencer esses domínios, no caso somente o CNPJ.

    Fiz um código em VBA , mas só aparece erro. Me ajudem, por favor

    O site que faço a pesquisa é esse: https://registro.br/

    Ex: Colo o domínio -> www.repassa.com.br e pego o cnpj.

    Tem aparecido o erro 438.

    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 17:19