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數據。至此問題解決。

 


免責聲明!

本站轉載的文章為個人學習借鑒使用,本站對版權不負任何法律責任。如果侵犯了您的隱私權益,請聯系本站郵箱yoyou2525@163.com刪除。



 
粵ICP備18138465號   © 2018-2025 CODEPRJ.COM