json - 使用 JSON 在 Excel 中导入数据
问题描述
我已经开发了一个从网站上抓取数据的代码,但由于我对 JSON 知之甚少,我可以得到如下图所示的输出:
但是,我在即时窗口中从网络上获取所有数据,但想像上面的快照一样组织这些字段。这是我的代码:
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
即时窗口中的输出是:
解决方案
下面向您展示如何使用 json 解析器。我使用jsonconverter.bas。将代码从那里复制到名为 JsonConverter 的标准模块后,您需要转到 VBE>Tools>References>Add reference to Microsoft Scripting Runtime。
在 json 响应中,{}
是按键访问的字典;是由索引(或以上)[]
访问的集合For Each
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
推荐阅读
- python - 使用 python 脚本按日期对 tsv 进行排序
- angular - angular - ag-grid 将日期选择器添加到日期单元格以进行编辑
- redis - 是否可以在 Redis 上同步主节点
- python - 为什么我在使用 Pickle 和 Socket 库 Python 时出现 Unpickling 错误
- sql - 表模式和名称的正则表达式验证
- python - sam deploy 失败并出现错误存储桶位于此区域:us-east-2。请将此区域用于 us-east-2
- python - 'builtin_function_or_method' 对象没有属性 'apply' cv2
- c++ - 用C++从一个段落中找到一个句子中的最大单词数
- rest - 使用 Bitrix 24 REST API 将 CRM 项目链接到日历事件
- angular - Highcharts:在 X/Y 轴末端添加箭头