Vba實現解析json數據。當中的關於Set oSC = CreateObject("MSScriptControl.ScriptControl") 不能建立對象的問題。

時間 2019-11-12

標籤 vba 實現解析 json 數據當中關於 set osc createobject msscriptcontrol.scriptcontrol msscriptcontrol scriptcontrol 不能建立對象問題欄目 Microsoft Office 简体版

原文原文鏈接

這幾天在word裏面寫宏，想解析服務器傳過來的json串。可是Set oSC = CreateObjectx86("MSScriptControl.ScriptControl")這個方法一直建立不了對象。shell

最後再網上看到說，word分爲32位的和64位的這個方法只有在32位的word裏面才能夠使用，在64位的裏面是實現不了的（不能建立對象）json

因而在網上找各類的方案解決。最後找到一個方法，本身重寫這個方法實現：（代碼以下）服務器

'讀取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