VBA help, web data extraction

[juracyamerico]

Hi excel gurus,

I almost there , but I not able to progress , i have my code below and I'd to ask for help.
Few free to comment about my code below , I not sure if this is the best way to do it.Thank you in advanced.

I try to get the data from the webpage as you can see in the code , but I'm not able to get some specific fields data , like for example NÚMERO DE INSCRIÇÃO, DATA DE ABERTURA, NOME EMPRESARIAL and LOGRADOURO and for each of those fields my desire is to place the data in indivduals cells via VBA

Any help wold be appreciate.
Thank you in advanced

Option Explicit


Sub extractTablesData()
Dim oIE As Object
Dim oObj As Object
Dim sCaptcha As String
Dim iT As Integer
Dim iR As Integer
Dim iC As Integer
Dim oElemCollection As Object
Dim tr

Set oIE = CreateObject("InternetExplorer.Application")

With oIE
    .StatusBar = False
    .Toolbar = False
    .Resizable = False
    .AddressBar = False
    .Visible = True
    .Navigate ("http://www.receita.fazenda.gov.br/PessoaJuridica/CNPJ/cnpjreva/Cnpjreva_Solicitacao2.asp")
    
    While oIE.ReadyState <> 4
    DoEvents
    Wend
    .Document.all.Item("cnpj").innerText = "06140942000232"
    
reset:
    .Document.getElementById("captcha").Focus

    sCaptcha = .Document.activeElement.Name

    Do While sCaptcha = "captcha"
    sCaptcha = .Document.activeElement.Name
    DoEvents
    Loop

    If .Document.all.Item("captcha").Value = "" Then GoTo reset

    .Document.all("submit1").Click

    For Each tr In .Document.getElementsByTagName("tr")
    If tr.innerText = "Erro na Consulta - Esclarecimentos adicionais.  " Then GoTo reset
    Next
   
    Do While oIE.Busy: DoEvents: Loop
    
    Set oElemCollection = oIE.Document.getElementsByTagName("TABLE")
    
For Each oElemCollection In .Document.all
   If oElemCollection.tagName = "TABLE" Then
      If oElemCollection.Rows.Length >= 1 Then
         Set tr = oElemCollection.Rows(0)
         If tr.Cells.Length >= 1 Then
            If Not InStr(oElemCollection.Rows(0).innerText, "REPÚBLICA FEDERATIVA DO BRASIL") > 0 Then
                If InStr(tr.Cells(0).innerText, "NÚMERO DE INSCRIÇÃO") > 0 Then
                    'MsgBox oElemCollection.Rows(0).Cells(0).innerText
                    ThisWorkbook.Worksheets(1).Cells(1, 1) = oElemCollection.Rows(0).Cells(0).innerText 'MsgBox oElemCollection.Rows(0).Cells(0).innertext
                    ThisWorkbook.Worksheets(1).Cells(1, 1).WrapText = False
                    'oElemCollection.rows(0).cells(2).innertext ' PEGA A DATA
                End If
                If InStr(tr.Cells(0).innerText, "DATA DE ABERTURA") > 0 Then
                    ThisWorkbook.Worksheets(1).Cells(2, 1) = oElemCollection.Rows(0).Cells(2).innerText
                    ThisWorkbook.Worksheets(1).Cells(2, 1).WrapText = False
                End If
                If InStr(tr.Cells(0).innerText, "NOME EMPRESARIAL") > 0 Then
 
                    ThisWorkbook.Worksheets(1).Cells(3, 1) = oElemCollection.Rows(0).Cells(0).innerText 'MsgBox oElemCollection.Rows(0).Cells(0).innertext
                    ThisWorkbook.Worksheets(1).Cells(3, 1).WrapText = False
                End If
            End If
         End If
      End If
   End If
Next
    
End With


Set oIE = Nothing
End Sub

 

[juracyamerico]

Hi,guys , any ideas?