Reputation: 369
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:
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:
Upvotes: 2
Views: 146
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