Maurice
Maurice

Reputation: 33

Scrape website with XML HTTP request with Excel VBA: wait for the page to fully load

I'm trying to scrape a product price from a webpage using Excel VBA. The following code is working when using VBA Internet Explorer navigate request. However I would like to use an XML HTTP request instead to speed up the scraping process.

In the IE request code I tell the application to wait for 3 seconds to have the page fully load and be able to scrape the product price. If this line is not included it won't find the price.

I tried to change this with an XML HTTP request (see the second code) but without success. No price output was found. It seems that the code tries to scrape the page before it has been fully loaded.

How can I adjust the XML HTTP request code so that it will find the product price (and only start searching/scraping when the page (and scripts) are fully loaded?

The following IE request code is working: (immediate debug.prints a price of the product)

Sub Get_Product_Price_AH_IE()

Dim IE As New SHDocVw.InternetExplorer
Dim HTMLDoc As MSHTML.HTMLDocument

Dim AHArticles As MSHTML.IHTMLElementCollection
Dim AHArticle As MSHTML.IHTMLElement

Dim AHEuros As MSHTML.IHTMLElementCollection
Dim AHCents As MSHTML.IHTMLElementCollection

Dim AHPriceEuro As Double
Dim AHPriceCent As Double
Dim AHPrice As Double


IE.Visible = False
IE.navigate "https://www.ah.nl/producten/product/wi3640/lu-bastogne-biscuits-original"


    Do While IE.readyState <> READYSTATE_COMPLETE
    Loop

    Set HTMLDoc = IE.document

'wait for the page to fully load to be able to get price data
Application.Wait Now + #12:00:03 AM#


Set AHArticles = HTMLDoc.getElementsByTagName("article")

For Each AHArticle In AHArticles

 If AHArticle.getAttribute("data-sku") = "wi3640" Then

        Set AHEuros = AHArticle.getElementsByClassName("price__integer")
        Set AHCents = AHArticle.getElementsByClassName("price__fractional")

       AHPriceEuro = AHEuros.Item(0).innerText
       AHPriceCent = AHCents.Item(0).innerText

      AHPrice = AHPriceEuro + (AHPriceCent / 100)

Debug.Print AHPrice

            Exit For
        End If


Next AHArticle

IE.Quit

End Sub

The following XML HTTP request is not giving the desired output (no price is printed in the immediate debug screen):

Sub Get_Product_Price_AH_XML()

Dim XMLReq As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument

Dim AHArticles As MSHTML.IHTMLElementCollection
Dim AHArticle As MSHTML.IHTMLElement

Dim AHEuros As MSHTML.IHTMLElementCollection
Dim AHCents As MSHTML.IHTMLElementCollection

Dim AHPriceEuro As Double
Dim AHPriceCent As Double
Dim AHPrice As Double


XMLReq.Open "GET", "https://www.ah.nl/producten/product/wi3640/lu-bastogne-biscuits-original", False
XMLReq.send


If XMLReq.Status <> 200 Then
    MsgBox "Problem" & vbNewLine & XMLReq.Status & " - " & XMLReq.statusText
    Exit Sub
    End If

HTMLDoc.body.innerHTML = XMLReq.responseText


Application.Wait Now + #12:00:03 AM#


Set AHArticles = HTMLDoc.getElementsByTagName("article")

For Each AHArticle In AHArticles

 If AHArticle.getAttribute("data-sku") = "wi3640" Then

        Set AHEuros = AHArticle.getElementsByClassName("price__integer")
        Set AHCents = AHArticle.getElementsByClassName("price__fractional")

       AHPriceEuro = AHEuros.Item(0).innerText
       AHPriceCent = AHCents.Item(0).innerText

      AHPrice = AHPriceEuro + (AHPriceCent / 100)

Debug.Print AHPrice

            Exit For
        End If


Next AHArticle


End Sub

Upvotes: 1

Views: 3147

Answers (1)

QHarr
QHarr

Reputation: 84475

REST API HTTP Request:

Your current method does not allow for the page to load fully as you have noted. You can formulate a REST API XMLHTTPrequest, using URLEncode to pass an encoded URL string to the API. The server sends back a JSON response containing the value you are after and lots of other info as well.

I demonstrate two methods of extracting the price info from the returned JSON string: ① Using the Split function to extract the price by generating substrings until the required string is left; ② Using a JSONParser to navigate the JSON structure and return the required value.

Code:

The following uses Split to extract the value.

Option Explicit
Public Sub GetPrice()
    Const BASE_URL As String = "https://www.ah.nl/service/rest/delegate?url="
    Dim URL As String, sResponse As String, price As String
    URL = BASE_URL & Application.WorksheetFunction.EncodeURL("/producten/product/wi3640/lu-bastogne-biscuits-original")

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
    End With
    price = Split(Split(sResponse, """now"":")(1), "}")(0)
    Debug.Print price
End Sub

Parsing the JSON response:

Using Split:

You could read the whole JSON response into a JSON object using a JSON parser, for example JSONConverter.bas. Then parse that object for price. I found it simpler to use Split function to extract the required info shown below:

Split returns a zero-based, one-dimensional array containing a specified number of substrings based on splitting the input string on a specified delimiter.

In the line,

price = Split(Split(sResponse, """now"":")(1), "}")(0)

I have two nested Split statements. These consecutively split the response JSON string to extract the price 1.55.

The first split is using "now": as the delimiter resulting in an array as follows:

enter image description here

The target price you can see is in the string at position 1.

So, that string is extracted with:

Split(sResponse, """now"":")(1)

We then need to get just the price so use Split again to grab the 1.55 by using the delimiter "}":

Split(Split(sResponse, """now"":")(1), "}")

This results in the following array (shortened as quite long):

enter image description here

The price we want is now at position 0 in the new array which is why we can use the following to extract the response.

price = Split(Split(sResponse, """now"":")(1), "}")(0)

Using JSON parser:

If you want to traverse the json structure you would use the following:

Dim json As Object
Set json = JsonConverter.ParseJson(sResponse)("_embedded")("lanes")(5)("_embedded")("items")(1)("_embedded")("product")("priceLabel")
Debug.Print json("now")

After downloading and adding the JSONConverter.bas, you then add a reference to Microsoft Scripting Runtime via VBE > Tools > References. The above Set json code statement represents the path to the price, as seen in the JSON structure below. I have collapsed some detail to make the path clearer. You would insert the above couple of lines, into the original code, in place of the Split line.

JSON Path

In the diagram above [] denotes a collection object which needs to be accessed via index, e.g. JsonConverter.ParseJson(sResponse)("_embedded")("lanes")(5). The {} denotes a dictionary object which can be accessed by key e.g. JsonConverter.ParseJson(sResponse)("_embedded")("lanes")(5)("_embedded"). The syntax in my line,

Set json = JsonConverter.ParseJson(sResponse)("_embedded")("lanes")(5)("_embedded")("items")(1)("_embedded")("product")("priceLabel")

demonstrates the different syntax to navigate these two object types.

Upvotes: 4

Related Questions