M Faizan Farooq
M Faizan Farooq

Reputation: 369

Import Data in excel using JSON

I have developed a code to scrape data from a website but since I know very little about JSON I could be able to get the output as required shown in below snap:

enter image description here However, I am getting all data from the web in the immediate window but want to organize these fields just like an above snap. Here is my code:

Sub FetchTabularInfo()
    Dim Http As New XMLHTTP60, Html As New HTMLDocument
    Dim col As Variant, icol As New Collection
    Dim csrf As Variant, I&

    With Http
        .Open "GET", "https://ngodarpan.gov.in/index.php/home/statewise_ngo/76/35/1", False
        .send
        Html.body.innerHTML = .responseText
    End With

    With Html.querySelectorAll(".table tr a[onclick^='show_ngo_info']")
        For I = 0 To .Length - 1
            icol.Add Split(Split(.Item(I).getAttribute("onclick"), "(""")(1), """)")(0)
        Next I
    End With

    For Each col In icol
        With Http
            .Open "GET", "https://ngodarpan.gov.in/index.php/ajaxcontroller/get_csrf", False
            .send
            csrf = .responseText
        End With

        csrf = Split(Replace(Split(csrf, ":")(1), """", ""), "}")(0)

        With Http
            .Open "POST", "https://ngodarpan.gov.in/index.php/ajaxcontroller/show_ngo_info", False
            .setRequestHeader "X-Requested-With", "XMLHttpRequest"
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
            .send "id=" & col & "&csrf_test_name=" & csrf
        End With

        Debug.Print Http.responseText
    Next col
End Sub

The output in the immediate window is:

enter image description here

Upvotes: 2

Views: 146

Answers (1)

QHarr
QHarr

Reputation: 84465

The following shows you how to use a json parser. I use jsonconverter.bas. After copying the code from there into a standard module called JsonConverter, you need to go VBE>Tools>References>Add reference to Microsoft Scripting Runtime.

In the json response the {} are dictionaries accessed by key; the [] are collections accessed by index (or For Each over)

Option Explicit

Public Sub FetchTabularInfo()
    Dim Http As New XMLHTTP60, Html As New HTMLDocument
    Dim col As Variant, icol As New Collection
    Dim csrf As Variant, i&

    With Http
        .Open "GET", "https://ngodarpan.gov.in/index.php/home/statewise_ngo/76/35/1", False
        .send
        Html.body.innerHTML = .responseText
    End With

    With Html.querySelectorAll(".table tr a[onclick^='show_ngo_info']")
        For i = 0 To .Length - 1
            icol.Add Split(Split(.item(i).getAttribute("onclick"), "(""")(1), """)")(0)
        Next i
    End With

    Dim r As Long, headers(), results(), ws As Worksheet

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    headers = Array("SrNo", "Name of VGO/NGO", "Address", "City", "State", "Tel", "Mobile", "Web", "Email")
    ReDim results(1 To icol.Count, 1 To UBound(headers) + 1)

    For Each col In icol
        r = r + 1
        With Http
            .Open "GET", "https://ngodarpan.gov.in/index.php/ajaxcontroller/get_csrf", False
            .send
            csrf = .responseText
        End With

        csrf = Split(Replace(Split(csrf, ":")(1), """", ""), "}")(0)

        Dim json As Object
        With Http
            .Open "POST", "https://ngodarpan.gov.in/index.php/ajaxcontroller/show_ngo_info", False
            .setRequestHeader "X-Requested-With", "XMLHttpRequest"
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
            .send "id=" & col & "&csrf_test_name=" & csrf
            Set json = JsonConverter.ParseJson(.responseText)

            Dim orgName As String, address As String, srNo As Long, city As String
            Dim state As String, tel As String, mobile As String, website As String, email As String

            On Error Resume Next
            orgName = json("registeration_info")(1)("nr_orgName")
            address = json("registeration_info")(1)("nr_add")
            city = json("registeration_info")(1)("nr_city")
            srNo = r '<unsure where this is coming from.
            state = Replace$(json("registeration_info")(1)("StateName"), "amp;", vbNullString)
            tel = IIf(IsNull(json("infor")("0")("Off_phone1")), vbNullString, json("infor")("0")("Off_phone1")) '<unsure where this is coming from. Need a csrf to test with
            mobile = json("infor")("0")("Mobile")
            website = json("infor")("0")("ngo_url")
            email = json("infor")("0")("Email")
            On Error GoTo 0

            Dim arr()
            arr = Array(srNo, orgName, address, city, state, tel, mobile, website, email)
            For i = LBound(headers) To UBound(headers)
               results(r, i + 1) = arr(i)
            Next
        End With
    Next col
    With ws
        .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        .Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With
End Sub

Upvotes: 2

Related Questions