Vba实现解析json数据。当中的关于Set oSC = CreateObject("MSScriptControl.ScriptControl") 不能创建对象的问题。

这几天在word里面写宏，想解析服务器传过来的json串。但是Set oSC = CreateObjectx86("MSScriptControl.ScriptControl")这个方法一直创建不了对象。

最后再网上看到说，word分为32位的和64位的这个方法只有在32位的word里面才可以使用，在64位的里面是实现不了的（不能创建对象）

于是在网上找各种的方案解决。最后找到一个方法，自己重写这个方法实现：（代码如下）

'读取json格式的文件。做转化
Function ReadJson(Optional a As String)
    Dim oSC As Object
    Set oSC = CreateObjectx86("MSScriptControl.ScriptControl") ' create ActiveX via x86 mshta host
    Debug.Print TypeName(oSC) ' ScriptControl
    '定义变量装获取到的json串
    Dim JSON As String
    JSON = a
    With oSC
        '操作oSC
        .Language = "Javascript"
        .Timeout = -1
        .AddCode "var json = " & JSON & ";"
        .Eval ("json.item[0].delist_time")
     'MsgBox .Eval("json.item[0].delist_time")
     
     ReadJson = .Eval("json.item[0].delist_time")
    
    End With
    CreateObjectx86 , True ' close mshta host window at the end
End Function

Function CreateObjectx86(Optional sProgID, Optional bClose = False)
    Static oWnd As Object
    Dim bRunning As Boolean
    #If Win64 Then
        bRunning = InStr(TypeName(oWnd), "HTMLWindow") > 0
        If bClose Then
            If bRunning Then oWnd.Close
            Exit Function
        End If
        If Not bRunning Then
            Set oWnd = CreateWindow()
            oWnd.execScript "Function CreateObjectx86(sProgID): Set CreateObjectx86 = CreateObject(sProgID): End Function", "VBScript"
        End If
        Set CreateObjectx86 = oWnd.CreateObjectx86(sProgID)
    #Else
        Set CreateObjectx86 = CreateObject("MSScriptControl.ScriptControl")
    #End If
End Function

Function CreateWindow()
    Dim sSignature, oShellWnd, oProc
    On Error Resume Next
    sSignature = Left(CreateObject("Scriptlet.TypeLib").GUID, 38)
    CreateObject("WScript.Shell").Run "%systemroot%\syswow64\mshta.exe about:""about:<head><script>moveTo(-32000,-32000);document.title='x86Host'</script><hta:application showintaskbar=no /><object id='shell' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2'><param name=RegisterAsBrowser value=1></object><script>shell.putproperty('" & sSignature & "',document.parentWindow);</script></head>""", 0, False
    Do
        For Each oShellWnd In CreateObject("Shell.Application").Windows
            Set CreateWindow = oShellWnd.GetProperty(sSignature)
            If Err.Number = 0 Then Exit Function
            Err.Clear
        Next
    Loop
End Function

然后分别在32位和64位的word上面都试过了。可以接卸json数据。至此问题解决。

 

posted on 2018-06-28 18:52  gxg123  阅读(5538)  评论(0)  编辑  收藏  举报

导航