• 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.

Can't Perform a reverse web lookup to get name against phone number using vba

shahin

Active Member
I've written a code to get the "name of the coffee shop" against a phone number embedded adjacent to a cell in my excel spreadsheet. My intention is to get the name using the phone number from that page. The phone number against which i am trying to get the name is "323-871-0143". But i'm not being able to grab it. For kind consideration i'm pasting my code below. The code doesn't show any error but to know more about it i used python module to get text of that page but it was unable to get that too. Finally my finding is that i am unable to reach that page using my code where the data belongs because of privacy error or something. I can reach that page only when i write manually the address in the chrome address bar. So my earnest request is that if i could get any helping hand to perform it the way i can get the result. Any help would be greatly appreciated.

Sub ReverseLookup()
Dim http As New MSXML2.XMLHTTP60, html As New MSHTML.HTMLDocument
Dim catgo As Object, data As Object, raw As Object
Dim Phone As String

Worksheets("sheet2").Select
Phone = Range("A1")

http.Open "GET", "http://www.whitepages.com/phone/1-" & Phone, False
http.send
html.body.innerHTML = http.responseText

Set catgo = html.getElementsByClassName("bottom-padding-large grey-text")(0)
Set raw = catgo.getElementsByTagName("p")

Range("B1").Select

For Each data In raw
ActiveCell.Value = data.innerText
ActiveCell.Offset(1, 0).Select
Next data

End Sub
 
Last edited:

First edit your post and use code tags !
Second, do not forget to add a crystal clear and complete explanation ‼

If you don't succed via a request, you could easily grab data piloting IE …
 

First edit your post and use code tags !
Second, do not forget to add a crystal clear and complete explanation ‼

If you don't succed via a request, you could easily grab data piloting IE …
Thanks for your sharp reply. I tried to edit my post the way you told me but yet i suppose i couldn't follow your instruction fully. Anyways, i do not wish to use IE that is why i am here to get a solution. Sorry, if i have bothered.
 
Please do not quote all previous post !
And there is an icon for the code !

It's at beginner level by just following
model object from a valid ID ! A starter :​
Code:
Sub Demo()
    With CreateObject("Msxml2.XMLHTTP")
        .Open "GET", "http://www.whitepages.com/phone/1-323-871-0143", False
        .setRequestHeader "DNT", "1"
         On Error Resume Next
        .send
         On Error GoTo 0
         If .Status <> 200 Then Beep: Exit Sub Else T$ = .responseText
    End With
    With CreateObject("htmlfile")
        .write T
        MsgBox .all("left").FirstChild.FirstChild.Children(1).Children(1).innerText
    End With
End Sub
Do you like it ? So thanks to click on bottom right Like !
 
Please do not quote all previous post !
And there is an icon for the code !

It's at beginner level by just following
model object from a valid ID ! A starter :​
Code:
Sub Demo()
    With CreateObject("Msxml2.XMLHTTP")
        .Open "GET", "http://www.whitepages.com/phone/1-323-871-0143", False
        .setRequestHeader "DNT", "1"
         On Error Resume Next
        .send
         On Error GoTo 0
         If .Status <> 200 Then Beep: Exit Sub Else T$ = .responseText
    End With
    With CreateObject("htmlfile")
        .write T
        MsgBox .all("left").FirstChild.FirstChild.Children(1).Children(1).innerText
    End With
End Sub
Do you like it ? So thanks to click on bottom right Like !

The code of yours is running smoothly until it reaches the msgbox and shows object variable or with block variable not set. Error 91. Perhaps it is my fault that i can't perform it the way it should.
 
Please do not quote all previous post !


As code had worked on my side,
we are facing antibot protection from this website !

You must use your webbrowser inner inspector tool
to see which request headers to add (basics when using web request !)
and maybe use another request engine like Msxml2.ServerXMLHTTP.6.0
or WinHttp.WinHttpRequest.5.1

The reason why it is far easier using IE !
 
This is the answer i needed to know and finally i got it. That means, my first written code was not erroneous either. It is the antibot protection which make my code fail to accomplish. Thanks a zillion for everything.
 

Before antibot protection, you must have some success (~ 5 tries).
Without any, code is wrong …​
 
Before antibot protection, you must have some success (~ 5 tries).
Without any, code is wrong …​

Sub WebLookup()
Dim http As New MSXML2.XMLHTTP60, htmldoc As New MSHTML.HTMLDocument
Dim catgo As Object, data As Object, raw As Object
Dim Phone As String

http.Open "GET", "http://www.whitepages.com/phone/1-323-871-0143", False
http.send
htmldoc.body.innerHTML = http.responseText
Set http = Nothing

Set catgo = htmldoc.getelementsbyclassname("title-wrapper")(1)
Set raw = catgo.getElementsByTagName("h1")
Range("B2").Select

For Each data In raw
ActiveCell.Value = data.innerText
ActiveCell.Offset(1, 0).Select
Next data
End Sub

This is the very code i was expecting. Now it is working fine. You were right, i did something wrong within my previously written code.
 
Back
Top