• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA Internet Explorer Automation - Insert value from cell to input and retrieve result

exc4libur

Member
I have a list of mobile numbers in column A:A and I wanted to find out what phone operator they belong to.

So, if you open the website link: http://www.qualoperadora.net/ and type inside the box "11976773331", the result will be the following:

Número:(11)97677-3331
Operadora: Claro - Celular
Portabilidade: Não
Estado: São Paulo


If anyone can help me accomplish this by VBA, I would very much appreciate it!
 
If you open that page using Excel
Goto Data, From Web
Enter the Telephone number
Then when the answer is returned you can click on the Yellow Arrow at the Top Left of the page
and insert it into your worksheet
 
If you open that page using Excel
Goto Data, From Web
Enter the Telephone number
Then when the answer is returned you can click on the Yellow Arrow at the Top Left of the page
and insert it into your worksheet

Hey Master Hui, thank you for replying.

So I tried what you suggested but the information I imported was different from the website.

Rgds,
Exc4.
 
Exc4

This was my first effort at extracting web data using VBA and the site isn't simple HTML so I was happy to get a result out

I hope you are happy with the outcome
 

Attachments

  • Extract Web Data.xlsm
    21.2 KB · Views: 43
Hi !

I prefer pilot IE at end not to display it and close it (.quit before End With)
and detect when final webpage finishes to load (avoiding pause like Wait) …

But better than pilot IE, there is an alternative faster way !
Needs less than a second to grab all data located within ID resultato

Try this demonstration in a new workbook,
must paste code to a worksheet module :​
Code:
Sub DemoXML()
    Const HST$ = "www.qualoperadora.net", URL$ = "http://" & HST & "/", ELT$ = "resultado"

    With CreateObject("Microsoft.XMLHTTP")
        .Open "POST", URL, False
        .setRequestHeader "Referer", URL
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .setRequestHeader "DNT", "1"
        .setRequestHeader "Host", HST
        On Error Resume Next
        .send "ref2115=" & URL & "&telefone=11976773331"
        On Error GoTo 0
        If .Status = 200 Then T$ = .ResponseText
    End With

    If InStr(T, ELT) Then
        With CreateObject("HTMLfile")
            .Write T

            If .parentWindow.clipboardData.setData("Text", .all(ELT).innerText) Then
                Application.ScreenUpdating = False:  [B2].CurrentRegion.Clear:  Me.Paste [B2]
               .parentWindow.clipboardData.clearData "Text"
            End If

            .Close
        End With
    Else
        Beep
    End If
    End
End Sub
 
Last edited:
If you open that page using Excel
Goto Data, From Web
Enter the Telephone number
Then when the answer is returned you can click on the Yellow Arrow at the Top Left of the page
and insert it into your worksheet
Hey Master Hui, thank you for replying.

So I tried what you suggested but the information I imported was different from the website.

Rgds,
Exc4.

Wow Hui! That's awesome, it worked perfectly.

Thank you very much!!!
 
Hi !

I prefer pilot IE at end not to display it and close it (.quit before End With)
and detect when final webpage finishes to load (avoiding pause like Wait) …

But better than pilot IE, there is an alternative faster way !
Needs less than a second to grab all data located within ID resultato
Try this demonstration in a new workbook, must paste code to a worksheet module :​
Code:
Sub DemoXML()
    Const HST$ = "www.qualoperadora.net", URL$ = "http://" & HST & "/", ELT$ = "resultado"

    With CreateObject("Microsoft.XMLHTTP")
        .Open "POST", URL, False
        .setRequestHeader "Referer", URL
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .setRequestHeader "DNT", "1"
        .setRequestHeader "Host", HST
        On Error Resume Next
        .send "ref2115=" & URL & "&telefone=11976773331"
        On Error GoTo 0
        If .Status = 200 Then T$ = .ResponseText
    End With

    If InStr(T, ELT) Then
        With CreateObject("HTMLfile")
            .Write T

            If .parentWindow.clipboardData.setData("Text", .all(ELT).innerText) Then
                Application.ScreenUpdating = False:  [B2].CurrentRegion.Clear:  Me.Paste [B2]
               .parentWindow.clipboardData.clearData "Text"
            End If

            .Close
        End With
    Else
        Beep
    End If
    End
End Sub

Hey Marc,

I tried the code but, there was an invalid use of keyword:

Code:
Application.ScreenUpdating = False:  [B2].CurrentRegion.Clear:  Me.Paste [B2]
 

Works like a charm on my side on computers with different Excel versions ! Bad luck for you …

Or you didn't read and apply the advice line just before the code ‼ For sure … :rolleyes:

To understand, select Me statement in code, hit F1 key and read …
 
I have the telephones lined up in column A, how do i change the code so that it runs through all of them?

Code:
 "&telefone=11976773331" [/]
 

Attach an exact sample workbook within a worksheet with data at right place
and for the first item the data result expected …​
 

Assuming numbers in column A, results in column B and titles in row 1,
try this new demonstration (paste code to the data worksheet module) :​
Code:
Sub DemoXMLnoe()
    Const HST$ = "www.qualoperadora.net", URL$ = "http://" & HST & "/", _
          SND$ = "ref2115=" & URL & "&telefone="

    Application.StatusBar = "        Web download …"
                      NOE = [A1].CurrentRegion.Columns(2).Value

    For R& = 2 To UBound(NOE)
        If NOE(R, 1) = "" Or Val(NOE(R, 1)) Then
            With CreateObject("Microsoft.XMLHTTP")
                .Open "POST", URL, False
                .setRequestHeader "Referer", URL
                .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
                .setRequestHeader "DNT", "1"
                .setRequestHeader "Host", HST
                On Error Resume Next
                .send SND & Cells(R, 1).Text
                On Error GoTo 0

                If .Status = 200 Then
                        S& = InStr(InStr(.ResponseText, "<title>") + 7, .ResponseText, " ") + 1
                    NOE(R, 1) = Mid(.ResponseText, S, InStr(S, .ResponseText, "</") - S)
                Else
                    NOE(R, 1) = .Status & " : " & .StatusText
                End If
            End With
        End If
    Next

    If R > 2 Then With [B1].Resize(UBound(NOE)): .Value = NOE: .Columns.AutoFit: End With
    Application.StatusBar = False:  End
End Sub

Enjoy it ! Moderate it according to your needs …​
 
Last edited:
Attach an exact sample workbook within a worksheet with data at right place
and for the first item the data result expected …​


Hi Marc,

Could you help me, its been a while and I tried running the code today and it didn't work. Please find an example attached.

Rgds
 

Attachments

  • Book1.xlsb
    14.8 KB · Views: 6

The website is now protected … After a while, the IP address is blocked …

So you have to see in your webbrowser what changes in the request
or go back to pilot Internet Explorer …
 

I just try to pilot IE, it works buf after a while :

« #Erro: Sessões excedidas para sua rede. »

So maybe you have to find out another website less protected …​
 
Last edited:

I was thinking I found a trick but after 5 phones numbers :

« ALERTA!
Consultas automatizadas não são permitidas,
caso insista seu acesso poderá ser negado.
»
 

Seems to work with a pause after each click :​
Code:
Sub DemoIE()
            Const MSG = "mensagem", RES = "resultado"
                   VA = Cells(1).CurrentRegion
Application.StatusBar = "        Web download …"

With CreateObject("InternetExplorer.Application")
    .Navigate "http://www.qualoperadora.net/"
    While .Busy Or .ReadyState < 4:  DoEvents:  Wend

    With .Document
        For R& = 2 To UBound(VA)
            If VA(R, 2) = "" Then
                .all("telefone").Value = VA(R, 1)
                .all("consultar").Click
                While .ReadyState <> "complete":  DoEvents:  Wend

                If IsObject(.all(RES)) Then
                    Cells(R, 2).Value = .all(RES).innerText
                    If R < UBound(VA) Then Application.Wait Now + 0.00003
                ElseIf IsObject(.all(MSG)) Then
                    T$ = .all(MSG).innerText
                    Exit For
                End If
            End If
        Next
    End With

    .Quit
End With

Application.StatusBar = False
If T > "" Then MsgBox T, vbExclamation, "  " & MSG
End Sub
You like ? So thanks to …
 
Seems to work with a pause after each click :​
Code:
Sub DemoIE()
            Const MSG = "mensagem", RES = "resultado"
                   VA = Cells(1).CurrentRegion
Application.StatusBar = "        Web download …"

With CreateObject("InternetExplorer.Application")
    .Navigate "http://www.qualoperadora.net/"
    While .Busy Or .ReadyState < 4:  DoEvents:  Wend

    With .Document
        For R& = 2 To UBound(VA)
            If VA(R, 2) = "" Then
                .all("telefone").Value = VA(R, 1)
                .all("consultar").Click
                While .ReadyState <> "complete":  DoEvents:  Wend

                If IsObject(.all(RES)) Then
                    Cells(R, 2).Value = .all(RES).innerText
                    If R < UBound(VA) Then Application.Wait Now + 0.00003
                ElseIf IsObject(.all(MSG)) Then
                    T$ = .all(MSG).innerText
                    Exit For
                End If
            End If
        Next
    End With

    .Quit
End With

Application.StatusBar = False
If T > "" Then MsgBox T, vbExclamation, "  " & MSG
End Sub
You like ? So thanks to …


YES!!!!!!!!!!!!!!
 
On my side, I can't access qualoperadora.net, and you ?

Request depends too how the webpage is coded.
And with qual-operadora.net like consultaoperadora.com.br,
data are not in the response code, like a protection, using scripts …

Without a trick :​
Code:
Sub DemoIE2()
VA = Cells(1).CurrentRegion

With CreateObject("InternetExplorer.Application")
    Application.StatusBar = "        Web download …"
    On Error GoTo NavEnd
    .Navigate "http://www.qual-operadora.net/"
    While .Busy Or .ReadyState < 4:  DoEvents:  Wend

    With .Document
        For R& = 2 To UBound(VA)
            If VA(R, 2) = "" Then
                With .forms(0)
                     .all("numero").Value = VA(R, 1)
                     .submit
                End With

                While .ReadyState <> "complete":  DoEvents:  Wend
                Cells(R, 2).Value = Replace$(Split(.forms(1).innerText, vbCrLf & "Quer")(0), vbCrLf & vbCrLf, vbLf)
            End If
        Next
    End With

NavEnd:
    Application.StatusBar = False
    .Quit
End With

If Err.Number Then Beep: If R Then Cells(R, 2).Value = "Err #" & Err.Number & " : " & Err.Description
End Sub
 
Back
Top