VBA Issue in Web Scraping-CodePudding

I'm trying to get the Product name, SKU number, New and Old price from "https://www.crateandbarrel.me/en-ae/search/sofas" webpage using below VBA but nothing is fecthing. It seens the HTML data which was fetched doesn't contain the information which I am requesting.

Sub webscrape()

Dim HTTPreq As New MSXML2.XMLHTTP60
Dim html As HTMLDocument
Dim url As String

url = "https://www.crateandbarrel.me/en-ae/search/sofas"

'send HTTP request to url

With HTTPreq
    .Open "Get", url, False
    .send
End With

response = HTTPreq.responseText

Debug.Print response

'read response html document

Set html = CreateObject("htmlfile")
html.body.innerHTML = response

r = 1
For Each divElement In html.getElementsByClassName("container container-grid")
    r = r   1
    Set divCollection = divElement.all
    For Each element In divCollection
        If InStr(element.className, "name") > 0 Then Range("A" & r).Value = element.innerText
        If element.className = "col-itemSKU -inner" Then Range("B" & r).Value = element.innerText
        If element.className = "price state-cross" Then Range("D" & r).Value = element.innerText
        If element.className = "crossed-price" Then Range("E" & r).Value = element.innerText
   Next element
Next divElement

 
End Sub

CodePudding user response：

Although the site's content is highly dynamic, it is loaded using an endpoint via ajax request, from which you can retrieve the JSON response by issuing an XMLHTTP request complying with the following method.

You can, however, fetch your required fields from the response using any json converter like VBA-JSON

Sub ScrapeContent()
    Const Url$ = "https://api.crateandbarrel.me/rest/v2/cab/products/search"
    Dim Html As HTMLDocument, sParams$
    Dim oHttp As Object
    
    sParams = "fields=products(code,earnablePoints,sellable,name,urlName,summary,price(FULL),badges(code,name),images(DEFAULT),stock(FULL),averageRating,crossedPrice(FULL),categories(name,code,url),swatches(FULL),variants(FULL),primaryCategory(FULL)),facets,pagination(DEFAULT),sorts(DEFAULT),freeTextSearch&query=sofas&currentPage=1&pageSize=24&lang=en&curr=AED"

    Set Html = New HTMLDocument
    Set oHttp = CreateObject("MSXML2.XMLHTTP")
    
    With oHttp
        .Open "GET", Url & "?" & sParams, True
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.150 Safari/537.36"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send
        While .readyState < 4: DoEvents: Wend
        MsgBox .responseText
    End With
End Sub