如何在没有外部库的情况下使用VBA解析JSON?

LA_*_*LA_ 18 vba json object

我有一个像下面这样的json:

{"sentences":[{"trans":"something ru","orig":"english word","translit":"Angliyskoye slovo","src_translit":""}], "src":"en","server_time":69}
Run Code Online (Sandbox Code Playgroud)

并解析它:

Function jsonDecode(jsonString As Variant)
    Set sc = CreateObject("ScriptControl"): sc.Language = "JScript"
    Set jsonDecode = sc.Eval("(" + jsonString + ")")
End Function

Set arr = jsonDecode(txt)
Run Code Online (Sandbox Code Playgroud)

结果 arr包含如下所示的值(在Watches中检查):

arr
 - sentences (type: Variant/Object/JScriptTypeInfo)
  - 0 (type: Variant/Object/JScriptTypeInfo)
    - orig (type: Variant/String)
    - trans (type: Variant/String)
    ...
  - Item 1 (type: Variant/Object/JScriptTypeInfo)
    - orig (type: Variant/String)
    - trans (type: Variant/String)
    ...
 - server_time
 - src
Run Code Online (Sandbox Code Playgroud)

arr.src运作良好,但我怎么能得到arr.sentences(0).trans?首先,VBA替换sentencesSentences,其次(当我试图手动更改JSON)它仍然不允许使用sentenses(0).

Jul*_*ech 15

我发现这个脚本示例很有用(来自http://www.mrexcel.com/forum/excel-questions/898899-json-api-excel.html#post4332075):

Sub getData()

    Dim Movie As Object
    Dim scriptControl As Object

    Set scriptControl = CreateObject("MSScriptControl.ScriptControl")
    scriptControl.Language = "JScript"

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "http://www.omdbapi.com/?t=frozen&y=&plot=short&r=json", False
        .send
        Set Movie = scriptControl.Eval("(" + .responsetext + ")")
        .abort
        With Sheets(2)
            .Cells(1, 1).Value = Movie.Title
            .Cells(1, 2).Value = Movie.Year
            .Cells(1, 3).Value = Movie.Rated
            .Cells(1, 4).Value = Movie.Released
            .Cells(1, 5).Value = Movie.Runtime
            .Cells(1, 6).Value = Movie.Director
            .Cells(1, 7).Value = Movie.Writer
            .Cells(1, 8).Value = Movie.Actors
            .Cells(1, 9).Value = Movie.Plot
            .Cells(1, 10).Value = Movie.Language
            .Cells(1, 11).Value = Movie.Country
            .Cells(1, 12).Value = Movie.imdbRating
        End With
    End With

End Sub
Run Code Online (Sandbox Code Playgroud)

  • 我收到“ActiveX 组件无法创建对象”。 (4认同)
  • 解决方案很简单,但我认为这有潜在的危险,因为解析器不是 JSON 解析器,而是 JScript 解析器,并且可能会在 JSON 中注入恶意代码。如果您信任 JSON 源并且仍然想使用此技术,至少添加 ScriptControl.UseSafeSubset = True。 (2认同)

小智 5

说我很简单,但我只是声明了一个 Variant,并在每个项目之间的引号逗号引号上拆分了 REST GET 中的响应文本,然后通过使用 InStrRev 查找最后一个引号来获取我想要的值。我确信这不像其他一些建议那么优雅,但它对我有用。

         varLines = Split(.responsetext, """,""")
        strType = Mid(varLines(8), InStrRev(varLines(8), """") + 1)
Run Code Online (Sandbox Code Playgroud)