“GET” request method not working in vba

[shahin]

Hi there everybody! I've written a code to fetch the name of a restaurant using its phone number applying "GET" http method but what i'm doing wrong with this process is beyond my knowledge. So, if anybody extends a helping hand to resolve this issue, i would be very grateful to him. Thanks in advance.

Sub test()

Dim xmlhttp As New MSXML2.XMLHTTP60, myHtml As New HTMLDocument
Dim PostData As String, ele As Object, thing As Object
Dim x As Long

x =2

PostData ="what=5197365924"
xmlhttp.Open "GET","http://mobile.canada411.ca/search/"& PostData,False
xmlhttp.setRequestHeader "Content-Type","text/xml"
xmlhttp.send
myHtml.body.innerHTML = xmlhttp.responseText


Set ele = myHtml.getElementsByClassName("merchant-title__name jsShowCTA")

For Each thing In ele
Cells(x,1)= thing.innertext
x = x +1
Next thing

EndSub

 

[Chihiro]

This site uses redirect and can't be directly scraped.

First print out xmlhttp.responseText to text file and see how and where it's redirecting. Then scrape using that info.

This case... you should find following string in initial xmlhttp.responseText

content="com.ypg.find://mobile.yellowpages.ca/bus/Ontario/Amherstburg/Downtown-Expresso-Cafe/522901.html?what=5197365924&where=Canada&redirect=reversetobusiness"

Now replace "com.ypg.find:" with "http:" and you should get the response you are looking for.

 

[shahin]

Thanks sir, for your kind reply. I will follow the method you suggested.

 

[shahin]

You are right sir, the requests get redirected to another webpage. However, changing "xlhttp60" to "serverxmlhttp60" I could get the result. The below code can grab the title from that webpage:

Sub Web_Data()
    Dim http As New ServerXMLHTTP60, html As New HTMLDocument
    Dim str_arg As String
   
    str_arg = "stype=re&what=5197365924"
   
    With http
        .Open "GET", "http://mobile.canada411.ca/search/?" & str_arg, False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .send
        html.body.innerHTML = .responseText
    End With
    [A1] = html.getElementsByClassName("merchant-title__name jsShowCTA")(0).innerText
End Sub

 

[shahin]

And the complete scraper looks more like below. It now grabs "the restaurant name" and "it's phone number" against each search. If anything I need to change to make it more robust, I'm happy to comply.

Sub Web_Data()
    Dim http As New ServerXMLHTTP60, html As New HTMLDocument
    Dim str_arg As String, post As HTMLHtmlElement
    Dim phone_numbers As Variant, phone As Variant
 
    phone_numbers = [{"416-787-9111", "647-490-2181", "647-360-1890", "416-849-1499"}]
 
    For Each phone In phone_numbers
        str_arg = "stype=re&what=" & phone
     
        With http
            .Open "GET", "http://mobile.canada411.ca/search/?" & str_arg, False
            .setRequestHeader "User-Agent", "Mozilla/5.0"
            On Error Resume Next
            .send
            On Error GoTo 0
            If .Status <> 200 Then Exit Sub
            html.body.innerHTML = .responseText
        End With

        For Each post In html.getElementsByClassName("merchant__header--root")
            With post.getElementsByClassName("merchant-title__name jsShowCTA")
                If .Length Then r = r + 1: Cells(r, 1) = .Item(0).innerText
            End With
            With post.getElementsByClassName("mlr__sub-text")
                If .Length Then Cells(r, 2) = .Item(0).innerText
            End With
        Next post
    Next phone
End Sub

At this stage I have got two problems.

1. The scraper is damn slow
2. Sometimes It throws an error (The data necessary to perform this operation is not yet available) when It hits the line ".Status <> 200". Ain't there any way so that when It catches such error, it will exit the sub gracefully?

The image below shows how that error looks like.