'Json scraping options VBA

i am trying to scrape date from https://www.jjfox.co.uk/aj-fernandez-bellas-artes-maduro.html using Json parser with the following code. the code does not however render any results. this is partially related to a question asked and answered earlier in here, however teh code has stoped working: Scraping website data with options in combo box VBA

    Option Explicit

Sub collectData()

Dim I As Integer
Dim bb As String
Dim a(1 To 1) As String

a(1) = "https://www.jjfox.co.uk/cigars/view-all.html?product_list_limit=all&product_list_order=name"
'a(2) = "https://www.jjfox.co.uk/best-sellers/show/all.html"
'a(3) = "https://www.jjfox.co.uk/new-arrivals/show/all.html"
'a(4) = "https://www.jjfox.co.uk/cigar-accessories/show/all.html"
'a(5) = "https://www.jjfox.co.uk/cigar-gifts/show/all.html"


For I = 1 To UBound(a)

    bb = texter(a(I))
    
Next I


    
    
End Sub


Public Function texter(ntx As String)

Dim cnt As Integer
Dim counter1 As Integer

Dim oHtml As HTMLDocument
Dim oElement As Object
Dim elm As Object

Set oHtml = New HTMLDocument

With CreateObject("MSXML2.ServerXMLHTTP.6.0")
    .Open "GET", ntx, False
    .send
    oHtml.body.innerHTML = .responseText
End With


Dim innerlink As String
counter1 = cnt

Set oElement = oHtml.getElementsByClassName("products wrapper grid products-grid")(0).getElementsByTagName("a")

For Each elm In oElement
    'If elm.className = "products-grid products-grid--max-3-col" Then
    
    
    innerlink = elm.href
    Debug.Print elm.href
   GetCigarData (innerlink)
   
    'End If
Next

End Function

Public Sub GetCigarData(hh As String)
    '<  VBE > Tools > References:
    'Microsoft Scripting Runtime
    'Microsoft HTML Object Library
    'Microsoft XML Library
    
    
    
    Dim json As Object, html As MSHTML.HTMLDocument, xhr As MSXML2.XMLHTTP60, ws As Worksheet
    Dim nme As Variant
    
    Set ws = ThisWorkbook.Worksheets("JJFox")
    ws.Activate
    Set xhr = New MSXML2.XMLHTTP60
    Set html = New MSHTML.HTMLDocument
    
    Dim lastrow As Double
    Dim cnt As Double
    
Cells(1, 1).Select
lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
cnt = lastrow + 1

Dim nump As Long
    
    nme = hh
    
    If hh <> "" Then
    
    If InStr(1, hh, "sampl", vbTextCompare) = 0 And InStr(1, hh, "best-of", vbTextCompare) = 0 And InStr(1, hh, "mini", vbTextCompare) = 0 And InStr(1, hh, "leather-case", vbTextCompare) = 0 And InStr(1, hh, "club", vbTextCompare) = 0 And InStr(1, hh, "box", vbTextCompare) = 0 And InStr(1, hh, "single", vbBinaryCompare) = 0 Then
    
        With xhr
            .Open "GET", hh, False
            .setRequestHeader "User-Agent", "Mozilla/5.0"
            .send
             html.body.innerHTML = .responseText
        End With
    
        On Error Resume Next
        
         Set json = JsonConverter.ParseJson(html.querySelector(".fieldset [type='text/x-magento-init']").innerHTML)("#product_addtocart_form")("configurable")("spConfig")
          
         Dim prices As Scripting.dictionary, options As Scripting.dictionary, optionsCollection As Collection
         
         Set prices = json("optionPrices")
         Set options = json("attributes")
         Set optionsCollection = options(options.Keys(0))("options")
         

        
         Dim results() As Variant, headers() As Variant, I As Long, name As String
         ReDim results(1 To optionsCollection.Count, 1 To 7)
         
         name = html.querySelector(".base").innerText
         
         Debug.Print name
         
        For I = 1 To optionsCollection.Count
              results(I, 1) = name
              results(I, 2) = optionsCollection.Item(I)("label")
              results(I, 3) = prices(prices.Keys(I - 1))("finalPrice")("amount")
              results(I, 4) = "JJFox"
              results(I, 5) = Now()
              results(I, 6) = ""
              results(I, 7) = nme
         Next
         
         'headers = Array("Name", "Size", "Price")
         
         With ws
             '.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
             .Cells(cnt, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
         End With
 
   End If
   End If
   
   Cells(lastrow, 7).Select
   Selection.AutoFill Destination:=Range(Cells(lastrow, 7), Cells(cnt, 7))
End Sub

The part that does not work is this, as it returns Nothing every time and i have no idea why:

         Set json = JsonConverter.ParseJson(html.querySelector(".fieldset [type='text/x-magento-init']").innerHTML)("#product_addtocart_form")("configurable")("spConfig")

     Dim prices As Scripting.dictionary, options As Scripting.dictionary, optionsCollection As Collection

     Set prices = json("optionPrices")
     Set options = json("attributes")
     Set optionsCollection = options(options.Keys(0))("options")


Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source