VBA研究64位系统下无法用ScriptControl控件解析JSon数据

Posted 2021-08-29 宋哥

作者：iamlaosong

我原来一个查邮件轨迹的工具，最近有人反映说是无法使用，我自己试了下发现没有问题。看他们发来的截图，发现数据查询没有问题，只是对结果解析的时候，没有分离出相关的字段内容。研究了一下发现，我们的差别是使用环境不同，他们用的是64位win10，我用的是32位win7（很土吧），调试发现，ScriptControl控件在64位系统下，无法解析JSon数据。也就是说，32位系统下的代码，在64位系统下失效了。

网上找了一下，发现有64位系统下使用ScriptControl控件的方法，通过预编译代码判断系统类型，但我想要是有个32位、64位通吃的方法不是更好吗？我曾经试过几种解析JSon数据的方法，这个控件不行，那就换一个试试，换了一个htmlFile控件后，问题解决。

下面是两种解决办法的代码： 

1、ScriptControl控件解析函数（32位系统有效）

'函数，从字符串中取出轨迹信息，返回条数
'关于Code：00=收寄、10=妥投、20=未妥投、30=、40=封车、41=解车、50=下段
Function get_trace(mystring As String) As Integer
    Dim objJSx As Object, objJSy As Object
    Dim n, j As Integer
    
    On Error Resume Next
    Set objJSx = CreateObject("ScriptControl")        '调用MSScriptControl.ScriptControl对象将提取的变量文本运算形成对象集合
    objJSx.Language = "javascript"                    '测试发现JavaScript、javascript、JScript都可以表示JavaScript语言
    
    '定义一个JS函数，通过计算表达式的方式引入JSON数据并解析
    jscode = "function json(s,i) { return eval('(' + s + ').traces[' + i + ']'); }"
    objJSx.AddCode jscode
    TT = "否"
    For n = 1 To MaxTrace
        If objJSx.Run("json", mystring, n - 1) = "" Then Exit For
        Set objJSy = objJSx.Run("json", mystring, n - 1)
        For j = 1 To 11
            TraceInfo(n, j) = ""
        Next j
        
        TraceInfo(n, 1) = objJSy.mailNum
        TraceInfo(n, 2) = objJSy.code
        TraceInfo(n, 3) = objJSy.operatingTime
        TraceInfo(n, 4) = objJSy.remark
        TraceInfo(n, 5) = objJSy.provName
        TraceInfo(n, 6) = objJSy.cityName
        TraceInfo(n, 7) = objJSy.countyName
        TraceInfo(n, 8) = objJSy.orgCode
        TraceInfo(n, 9) = objJSy.orgName
        TraceInfo(n, 10) = objJSy.operator
        TraceInfo(n, 11) = objJSy.code2
        'Debug.Print n & ":" & objJSy.operatingTime & objJSy.cityName & objJSy.remark
        If objJSy.code = "10" Then TT = "是"
    Next n
    
    get_trace = n - 1
End Function

2、HTMLFile控件（32/64位系统均有效）

'函数，从字符串中取出轨迹信息，返回条数
'关于Code：00=收寄、10=妥投、20=未妥投、30=、40=封车、41=解车、50=下段
Function get_trace(mystring As String) As Integer
    Dim n, j As Integer
    Dim objHTML, objJSy, objWin As Object
 
    On Error Resume Next
    Set objHTML = CreateObject("HTMLFile")
    Set objWin = objHTML.parentWindow
    objWin.execScript "var json = " & mystring, "JScript"     '定义一个JS变量，将JSON数据引入

    TT = "否"
    For n = 1 To MaxTrace
         '再定义一个JS变量，取出前面引入数组的一个元素，实际就是利用JS对数据进行解析
        objWin.execScript "var json_tr = json.traces[" & n - 1 & "];", "JScript"
        If objWin.json_tr = "" Then Exit For
        Set objJSy = objWin.json_tr
        
        For j = 1 To 11
            TraceInfo(n, j) = ""
        Next j
        
        TraceInfo(n, 1) = objJSy.mailNum
        TraceInfo(n, 2) = objJSy.code
        TraceInfo(n, 3) = objJSy.operatingTime
        TraceInfo(n, 4) = objJSy.remark
        TraceInfo(n, 5) = objJSy.provName
        TraceInfo(n, 6) = objJSy.cityName
        TraceInfo(n, 7) = objJSy.countyName
        TraceInfo(n, 8) = objJSy.orgCode
        TraceInfo(n, 9) = objJSy.orgName
        TraceInfo(n, 10) = objJSy.operator
        TraceInfo(n, 11) = objJSy.code2
        'Debug.Print n & ":" & objJSy.operatingTime & objJSy.cityName & objJSy.remark
        If objJSy.code = "10" Then TT = "是"
    Next n
    
    get_trace = n - 1
End Function

注意：代码中的“On Error Resume Next”是必须的，因为数据中不一定所有需要的字段都有，如果没有这一句，解析不存在的字段时就会报错，加了这一句，就会自动跳到下一句执行。

参见：【VBA研究】解析JSON数据的几种方法

在x64 OFFICE中使用ScriptControl控件的方法