Excel VBA解析JSON数据

JSON本质上是按照JavaScript对象、数组书写的一堆字符串,很可惜VBA直到目前为止都没有相应解析的方法。对于简单的数据可以用split方法、或者使用正则表达式来提取，如果过于复杂就需要用JavaScript语言来解析了。

---

 实现过程：

我们先请求一组JSON数据来分析解析过程:

1、先通过winhttp对象请求视频收藏夹一组JSON数据。

Sub json解析()
    Dim url$, data$
    url = "JSON数据的请求地址"
    data = getJSON(url)'拿到JSON数据
End Sub

Function getJSON(url)
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", url, True
        .send
        .WaitForResponse
        getJSON = .ResponseText
    End With
End Function

2、接着创建ScriptControl对象来使用 JavaScript语言。

3、用AddCode方法添加一段js代码，把JSON数据传入到js执行，var data变量接收JSON数据。后面使用js.eval方法获取想要的值。

4、我想要的数据都在medias数组里，根据js访问对象属性的方法：data.data.medias。然后获取该属性的长度Length，遍历每一个视频的基本信息

Sub json解析()
    Dim url$, data$
    url = Join([{"media_id=1017007045","pn=1","ps=20","order=mtime","type=0","tid=0","platform=web","jsonp=jsonp"}], "&")
    data = getJSON(getHeader() & url) '拿到JSON数据
    
    Dim sht As Object, js As Object, l%, i%
    Set sht = ThisWorkbook.Sheets(1) '将Sheet1工作表对象赋值给sht变量
    sht.[A1:F1] = Array("up", "视频标题", "视频简介", "up主页", "视频封面", "视频ID") '设置表头
    
    '以下是解析JSON的过程
    Set js = CreateObject("ScriptControl") '------------------------创建ScriptControl对象来使用JavaScript语言
    js.Language = "JScript" '---------------------------------------设置JavaScript语言
    js.AddCode "var data=(" & data & ");var list=data.data.medias" '添加js代码,这里是把JSON数据传递给js变量,需要的视频列表在medias属性里面
    
    l = js.eval("a=list.length") '获取list数组长度
    With sht
        For i = 0 To l - 1 '在js中,数组索引由0开始,所以-1
            .Cells(i + 2, 1) = js.eval("a=list[" & i & "].upper.name") 'up
            .Cells(i + 2, 2) = js.eval("a=list[" & i & "].title") '视频标题
            .Cells(i + 2, 3) = js.eval("a=list[" & i & "].intro") '视频简介
            .Cells(i + 2, 4) = js.eval("a=list[" & i & "].upper.mid") 'up主页
            .Cells(i + 2, 5) = js.eval("a=list[" & i & "].cover") '视频封面
            .Cells(i + 2, 6) = js.eval("a=list[" & i & "].bvid") '视频ID
        Next
        .Rows("1:" & l + 2).RowHeight = 13.5 '设置行高
    End With
    
End Sub

Function getHeader()
    getHeader = Join([{"htt","ps://ap","i.bili","bili.c","om/","x/v3/fav/resource/list?"}], "")
End Function

Function getJSON(url As String)
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", url, True
        .send
        .WaitForResponse
        getJSON = .ResponseText
    End With
End Function

---

解析后的效果：