Question

所以我之前从未使用过API，而且我对VBA还不熟悉。但是，我正在尝试使用以下API http://api.scb.se/OV0104/v1/doris/sv/ssd/START/FM/FM0401/MFIM1 自动下载数据到VBA（源是goo.gl/NgMBe，你也可以看到表），但我被卡住了。

你们有没有人在一个有着相同目的的工作VBA上有一个例子？书籍的任何链接？我试过谷歌搜索，但堆栈是堆栈。

Answer 1

该JSON数据，例如，可以使用JScript解析：

VBA模块：

Option Explicit

Function GetData(myUrl As String) As String
    Dim winHttpReq As Object

    Set winHttpReq = CreateObject("Microsoft.XMLHTTP")

    winHttpReq.Open "GET", myUrl, False
    winHttpReq.Send

    GetData = winHttpReq.ResponseText
End Function

''http://stackoverflow.com/questions/14822672/parsing-a-json-object-array-in-excel-vba#14823059
Sub OutputJsonStuff()
    Dim FSO
    Dim JScriptTS As TextStream
    Dim JScriptText As String
    Dim JSONdata As String

    Set FSO = CreateObject("Scripting.FileSystemObject")

    JSONdata = GetData("http://api.scb.se/OV0104/v1/doris/sv/ssd/START/FM/FM0401/MFIM1")

    Set JScriptTS = FSO.OpenTextFile("jsonFunctions.js", ForReading)
    JScriptText = JScriptTS.ReadAll
    JScriptTS.Close

    Dim oScriptEngine
    Set oScriptEngine = CreateObjectx86("ScriptControl")
    oScriptEngine.Language = "JScript"

    oScriptEngine.Eval "var obj=(" & JSONdata & ")"
    oScriptEngine.AddCode JScriptText

    Dim valueTexts() As String, i
    valueTexts = Split(oScriptEngine.Run("getValueTexts"), ";")

    ''output all value texts
    For i = 1 To UBound(valueTexts)
        Debug.Print valueTexts(i)
    Next i

    Dim title As String
    Dim variablesCode As String

    title = oScriptEngine.Run("getTitle")
    variablesCode = oScriptEngine.Run("getVariablesCode")

    Debug.Print title
    Debug.Print variablesCode

    DisposeScriptEngine
End Sub


''This is not really necessary if youre not on 64 bit: http://stackoverflow.com/questions/9725882/getting-scriptcontrol-to-work-with-excel-2010-x64/38134477
Public Sub DisposeScriptEngine()
    CreateObjectx86 Empty
End Sub

Function CreateObjectx86(sProgID)
    Static oWnd As Object
    Dim bRunning As Boolean

    #If Win64 Then
        bRunning = InStr(TypeName(oWnd), "HTMLWindow") > 0
        If IsEmpty(sProgID) 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
        If Not IsEmpty(sProgID) Then Set CreateObjectx86 = CreateObject(sProgID)
    #End If

End Function

Function CreateWindow()
    ' source http://forum.script-coding.com/viewtopic.php?pid=75356#p75356
    Dim sSignature, oShellWnd, oProc

    On Error Resume Next
    sSignature = Left(CreateObject("Scriptlet.TypeLib").GUID, 38)
    CreateObject("WScript.Shell").Run "%systemroot%\syswow64\mshta.exe 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

如果您不在64位计算机上，则可以使用CreateObject而不是CreateObjectx86。

jsonFunctions.JS（如果需要，可以在VBA代码中使用字符串文字，而不是从文件中加载函数）：

function getValueTexts() {
    var valueTexts = obj.variables[0].valueTexts;
    var result = "";
    for(var i = 0; i < valueTexts.length; i++) { result += valueTexts[i] + ";"; }
    return result.substring(0, result.length-1);
}

function getTitle() {
    return obj.title;
}

function getVariablesCode() {
    return obj.variables[0].code;
}

/*
var obj;

loadObj();

WScript.Echo(getTitle());
WScript.Echo(getVariablesCode());
WScript.Echo(getValueTexts());
*/


/*
function getData() {
    var data  = "";
    var url = 'http://api.scb.se/OV0104/v1/doris/sv/ssd/START/FM/FM0401/MFIM1'; // set your page url here
    with (new ActiveXObject("Microsoft.XmlHttp")) {
        open('GET', url, false);
        send('');

        data = responseText;
    }
    return data;
}

function loadObj(){
    eval("obj = (" + getData() + ");");
}
*/

.js文件中注释掉的代码是我在从VBA调用它之前开发脚本的方式

编辑：这有助于理解数据结构：http://jsonprettyprint.com

如何在vba中使用此API？

1 个答案: