web-dev-qa-db-ja.com

VB6 / VBA用のJSONパーサーはありますか？

VB6でWebサービスを使用しようとしています。私が制御するサービスは現在、SOAP/XMLメッセージまたはJSONを返すことができます。 VB6のSOAPタイプ（バージョン1）がobjectのような単純なタイプではなく、返されたstringを処理できるかどうかを判断するのは本当に困難です。 intなど。これまでのところ、返されたオブジェクトをVB6で再生するために何をする必要があるかわかりません。

そのため、Webサービスの応答をJSON文字列としてシリアル化できると考えました。 VB6用のJSONパーサーはありますか？

web-servicesjsonvbaserializationvb6
38
Ben McCormack

JSON.org をチェックして、さまざまな言語のJSONパーサーの最新リスト（メインページの下部を参照）を確認してください。この記事の執筆時点では、2つの異なるJSONパーサーへのリンクが表示されます。

  • VB-JSON

    • Zipファイルをダウンロードしようとしたときに、データが破損しているとWindowsが言いました。しかし、 7-Zip を使用してファイルを引き出すことができました。 7-Zipはメインの「フォルダー」の内容を見ることができるため、Zipファイルのメインの「フォルダー」はWindowsによってフォルダーとして認識されないため、それを開いて、それに応じてファイルを抽出できます。

    • このVB JSONライブラリの実際の構文は本当に簡単です。

      Dim p As Object
Set p = JSON.parse(strFormattedJSON)

'Print the text of a nested property '
Debug.Print p.Item("AddressClassification").Item("Description")

'Print the text of a property within an array '
Debug.Print p.Item("Candidates")(4).Item("ZipCode")
    • 注：VBAエディターの[ツール]> [参照設定]を使用して、「Microsoft Scripting Runtime」および「Microsoft ActiveX Data Objects 2.8」ライブラリを参照として追加する必要がありました。
    • 注：VBJSONコードは、実際にはGoogleコードプロジェクト vba-json に基づいています。ただし、VBJSONは元のバージョンからのいくつかのバグ修正を約束します。
  • PW.JSON
    • これは実際にはVB.NETのライブラリであるため、あまり時間をかけずに調べました。
39
Ben McCormack

私にとってはうまくいかなかったozmikeソリューションの構築（Excel 2013およびIE10）。その理由は、公開されたJSONオブジェクトのメソッドを呼び出せなかったためです。そのため、そのメソッドはDOMElementに関連付けられた関数を介して公開されています。これが可能であることを知らなかった（そのIDispatchのものでなければなりません）、ありがとうozmike。

Ozmikeが述べたように、サードパーティのライブラリはなく、わずか30行のコードです。

Option Explicit

Public JSON As Object
Private ie As Object

Public Sub initJson()
    Dim html As String

    html = "<!DOCTYPE html><head><script>" & _
    "Object.prototype.getItem=function( key ) { return this[key] }; " & _
    "Object.prototype.setItem=function( key, value ) { this[key]=value }; " & _
    "Object.prototype.getKeys=function( dummy ) { keys=[]; for (var key in this) if (typeof(this[key]) !== 'function') keys.Push(key); return keys; }; " & _
    "window.onload = function() { " & _
    "document.body.parse = function(json) { return JSON.parse(json); }; " & _
    "document.body.stringify = function(obj, space) { return JSON.stringify(obj, null, space); }" & _
    "}" & _
    "</script></head><html><body id='JSONElem'></body></html>"

    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .navigate "about:blank"
        Do While .Busy: DoEvents: Loop
        Do While .readyState <> 4: DoEvents: Loop
        .Visible = False
        .document.Write html
        .document.Close
    End With

    ' This is the body element, we call it JSON:)
    Set JSON = ie.document.getElementById("JSONElem")

End Sub

Public Function closeJSON()
    ie.Quit
End Function

次のテストでは、JavaScriptオブジェクトをゼロから構築し、それを文字列化します。次に、オブジェクトを解析して戻し、そのキーを反復処理します。

Sub testJson()
    Call initJson

    Dim jsObj As Object
    Dim jsArray As Object

    Debug.Print "Construction JS object ..."
    Set jsObj = JSON.Parse("{}")
    Call jsObj.setItem("a", 1)
    Set jsArray = JSON.Parse("[]")
    Call jsArray.setItem(0, 13)
    Call jsArray.setItem(1, Math.Sqr(2))
    Call jsArray.setItem(2, 15)
    Call jsObj.setItem("b", jsArray)

    Debug.Print "Object: " & JSON.stringify(jsObj, 4)

    Debug.Print "Parsing JS object ..."
    Set jsObj = JSON.Parse("{""a"":1,""b"":[13,1.4142135623730951,15]}")

    Debug.Print "a: " & jsObj.getItem("a")
    Set jsArray = jsObj.getItem("b")
    Debug.Print "Length of b: " & jsArray.getItem("length")
    Debug.Print "Second element of b: "; jsArray.getItem(1)

    Debug.Print "Iterate over all keys ..."
    Dim keys As Object
    Set keys = jsObj.getKeys("all")

    Dim i As Integer
    For i = 0 To keys.getItem("length") - 1
        Debug.Print keys.getItem(i) & ": " & jsObj.getItem(keys.getItem(i))
    Next i

    Call closeJSON
End Sub

出力

Construction JS object ...
Object: {
    "a": 1,
    "b": [
        13,
        1.4142135623730951,
        15
    ]
}
Parsing JS object ...
a: 1
Length of b: 3
Second element of b:  1,4142135623731 
Iterate over all keys ...
a: 1
b: 13,1.4142135623730951,15
14
Wolfgang Kuehn

これは古い質問ですが、私の答えは「vba json」を検索した後もこのページにアクセスし続ける他の人にとって大きな助けになることを願っています。

私はこれを見つけました page は非常に役に立ちました。 JSON形式のデータ処理を処理するいくつかのExcel互換VBAクラスを提供します。

7
dashmug

更新：Evalを使用するよりもJSONを解析するより安全な方法が見つかりました。このブログ投稿はEvalの危険性を示しています... http://exceldevelopmentplatform.blogspot.com/2018/01 /vba-parse-json-safer-with-jsonparse-and.html

このパーティーに遅刻しましたが、申し訳ありませんが、最も簡単な方法は、Microsoft Script Controlを使用することです。 VBA.CallByNameを使用してドリルインするサンプルコード

'Tools->References->
'Microsoft Script Control 1.0;  {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}; C:\Windows\SysWOW64\msscript.ocx

Private Sub TestJSONParsingWithCallByName()

    Dim oScriptEngine As ScriptControl
    Set oScriptEngine = New ScriptControl
    oScriptEngine.Language = "JScript"

    Dim sJsonString As String
    sJsonString = "{'key1': 'value1'  ,'key2': { 'key3': 'value3' } }"


    Dim objJSON As Object
    Set objJSON = oScriptEngine.Eval("(" + sJsonString + ")")
    Debug.Assert VBA.CallByName(objJSON, "key1", VbGet) = "value1"
    Debug.Assert VBA.CallByName(VBA.CallByName(objJSON, "key2", VbGet), "key3", VbGet) = "value3"

End Sub

実際に、JSON/VBA関連のトピックを探る一連のQ＆Aを行いました。

Q1 Windows上のExcel VBAで、IDEの大文字化動作によって壊れた解析済みJSONのドット構文トラバーサルの問題を軽減する方法？

Q2 Windows上のExcel VBAでは、解析されたJSON配列をループする方法？

Q3 Windows上のExcel VBAでは、解析されたJSON変数に対して「[オブジェクトオブジェクト]」の代わりに文字列化されたJSON表現を取得する方法？

Q4 Windows Excel VBAでは、JSONキーを取得して「ランタイムエラー '438'：オブジェクトはこのプロパティまたはメソッドをサポートしていません」をプリエンプトする方法

Q5 WindowsのExcel VBAでは、解析されたJSON変数について、このJScriptTypeInfoとは何ですか？

5
S Meaden

「ネイティブ」VB JSONライブラリ。

IE8 +に既にあるJSONを使用することは可能です。これにより、古くなってテストされていないサードパーティのライブラリに依存しなくなります。

amedeusの代替バージョンを参照してください こちら

Sub myJSONtest()


Dim oJson As Object
Set oJson = oIE_JSON() ' See below gets IE.JSON object

' using json objects
Debug.Print oJson.parse("{ ""hello"": ""world"" }").hello ' world
Debug.Print oJson.stringify(oJson.parse("{ ""hello"": ""world"" }")) ' {"hello":"world"}

' getting items
Debug.Print oJson.parse("{ ""key1"": ""value1"" }").key1 ' value1
Debug.Print oJson.parse("{ ""key1"": ""value1"" }").itemGet("key1") ' value1
Debug.Print oJson.parse("[ 1234, 4567]").itemGet(1) '  4567

' change  properties
Dim o As Object
Set o = oJson.parse("{ ""key1"": ""value1"" }")
o.propSetStr "key1", "value\""2"
Debug.Print o.itemGet("key1") ' value\"2
Debug.Print oJson.stringify(o) ' {"key1":"value\\\"2"}
o.propSetNum "key1", 123
Debug.Print o.itemGet("key1") ' 123
Debug.Print oJson.stringify(o) ' {"key1":123}

' add properties
o.propSetNum "newkey", 123 ' addkey! JS MAGIC
Debug.Print o.itemGet("newkey") ' 123
Debug.Print oJson.stringify(o) ' {"key1":123,"newkey":123}

' assign JSON 'objects' to properties
Dim o2 As Object
Set o2 = oJson.parse("{ ""object2"": ""object2value"" }")
o.propSetJSON "newkey", oJson.stringify(o2) ' set object
Debug.Print oJson.stringify(o) ' {"key1":123,"newkey":{"object2":"object2value"}}
Debug.Print o.itemGet("newkey").itemGet("object2") ' object2value

' change array items
Set o = oJson.parse("[ 1234, 4567]") '
Debug.Print oJson.stringify(o) ' [1234,4567]
Debug.Print o.itemGet(1)
o.itemSetStr 1, "234"
Debug.Print o.itemGet(1)
Debug.Print oJson.stringify(o) ' [1234,"234"]
o.itemSetNum 1, 234
Debug.Print o.itemGet(1)
Debug.Print oJson.stringify(o) ' [1234,234]

' add array items
o.itemSetNum 5, 234 ' add items! JS Magic
Debug.Print o.itemGet(5) ' 234
Debug.Print oJson.stringify(o) ' [1234,234,null,null,null,234]

' assign JSON object to array item
o.itemSetJSON 3, oJson.stringify(o2)  ' assign object
Debug.Print o.itemGet(3) '[object Object]
Debug.Print oJson.stringify(o.itemGet(3)) ' {"object2":"object2value"}
Debug.Print oJson.stringify(o) ' [1234,234,null,{"object2":"object2value"},null,234]


oIE_JSON_Quit ' quit IE, must shut down or the IE sessions remain.
Debug.Print oJson.stringify(o) ' can use after but but IE server will shutdown... soon
End Sub

VBからIE.JSONにブリッジできます。
関数oIE_JSONを作成します

Public g_IE As Object ' global


Public Function oIE_JSON() As Object


    ' for array access o.itemGet(0) o.itemGet("key1")
    JSON_COM_extentions = "" & _
            " Object.prototype.itemGet        =function( i ) { return this[i] }   ;            " & _
            " Object.prototype.propSetStr     =function( prop , val ) { eval('this.' + prop + '  = ""' + protectDoubleQuotes (val) + '""' )   }    ;            " & _
            " Object.prototype.propSetNum     =function( prop , val ) { eval('this.' + prop + '  = ' + val + '')   }    ;            " & _
            " Object.prototype.propSetJSON    =function( prop , val ) { eval('this.' + prop + '  = ' + val + '')   }    ;            " & _
            " Object.prototype.itemSetStr     =function( prop , val ) { eval('this[' + prop + '] = ""' + protectDoubleQuotes (val) + '""' )   }    ;            " & _
            " Object.prototype.itemSetNum     =function( prop , val ) { eval('this[' + prop + '] = ' + val )   }    ;            " & _
            " Object.prototype.itemSetJSON    =function( prop , val ) { eval('this[' + prop + '] = ' + val )   }    ;            " & _
            " function protectDoubleQuotes (str)   { return str.replace(/\\/g, '\\\\').replace(/""/g,'\\""');   }"

    ' document.parentwindow.eval dosen't work some versions of ie eg ie10?
     IEEvalworkaroundjs = "" & _
         " function IEEvalWorkAroundInit ()   { " & _
         " var x=document.getElementById(""myIEEvalWorkAround"");" & _
         " x.IEEval= function( s ) { return eval(s) } ; } ;"

    g_JS_framework = "" & _
      JSON_COM_extentions & _
      IEEvalworkaroundjs

    ' need IE8 and DOC type
    g_JS_HTML = "<!DOCTYPE html>  " & _
         " <script>" & g_JS_framework & _
                  "</script>" & _
         " <body>" & _
         "<script  id=""myIEEvalWorkAround""  onclick=""IEEvalWorkAroundInit()""  ></script> " & _
                 " HEllo</body>"

On Error GoTo error_handler

' Create InternetExplorer Object
Set g_IE = CreateObject("InternetExplorer.Application")
With g_IE
    .navigate "about:blank"
    Do While .Busy: DoEvents: Loop
    Do While .ReadyState <> 4: DoEvents: Loop
    .Visible = False ' control IE interface window
    .Document.Write g_JS_HTML
End With

Set objID = g_IE.Document.getElementById("myIEEvalWorkAround")
objID.Click ' create  eval
Dim oJson As Object

'Set oJson = g_IE.Document.parentWindow.Eval("JSON") ' dosen't work some versions of IE
Set oJson = objID.IEEval("JSON")

Set objID = Nothing
Set oIE_JSON = oJson

Exit Function
error_handler:
MsgBox ("Unexpected Error, I'm quitting. " & Err.Description & ".  " & Err.Number)
g_IE.Quit
Set g_IE = Nothing

End Function

Public Function oIE_JSON_Quit()
         g_IE.Quit
         Exit Function
End Function

役に立つと思うなら、賛成票を投じてください

4
ozmike

VBA-JSONティムホール、MITライセンスおよびGitHub。 vba-json の別の分岐点は、2014年末に登場しました。MacOfficeとWindows 32ビットおよび64ビットで動作すると主張されています。

4
Patrick Böker

VB6-JsonBag、別のJSONパーサー/ジェネレーター も、ほとんど問題なくVBAにインポートできるはずです。

3
Bob77

Jsonは文字列に過ぎないため、構造がどれほど複雑であっても、正しい方法で操作できれば簡単に処理できます。トリックを行うために外部ライブラリまたはコンバーターを使用する必要はないと思います。文字列操作を使用してJSONデータを解析した例を次に示します。

Sub GetJsonContent()
    Dim http As New XMLHTTP60, itm As Variant

    With http
        .Open "GET", "http://jsonplaceholder.typicode.com/users", False
        .send
        itm = Split(.responseText, "id"":")
    End With

    x = UBound(itm)

    For y = 1 To x
        Cells(y, 1) = Split(Split(itm(y), "name"": """)(1), """")(0)
        Cells(y, 2) = Split(Split(itm(y), "username"": """)(1), """")(0)
        Cells(y, 3) = Split(Split(itm(y), "email"": """)(1), """")(0)
        Cells(y, 4) = Split(Split(itm(y), "street"": """)(1), """")(0)
    Next y
End Sub
2
SIM

VB.NETでExcel-DNAアドインを作成できます。 Excel-DNAは、XLLを.NETで作成できるシンライブラリです。この方法で、.NETユニバース全体にアクセスし、 http://james.newtonking.com/json のようなものを使用できます-カスタムクラスでJSONをデシリアライズするJSONフレームワーク。

興味のある方は、VB.NETを使用してExcel用の汎用Excel JSONクライアントを作成する方法をご紹介します。

http://optionexplicitvba.com/2014/05/09/developing-a-json-Excel-add-in-with-vb-net/

そして、コードへのリンクは次のとおりです。 https://github.com/spreadgit/Excel-json-client/blob/master/Excel-json-client.dna

2
Bjoern Stiel

.Netコンポーネントを使用することをお勧めします。 Interop を介してVB6から.Netコンポーネントを使用できます-ここに tutorial があります。私の推測では、.Netコンポーネントは、VB6用に作成されたものよりも信頼性が高く、より適切にサポートされます。

Microsoft .Netフレームワークには、 DataContractJsonSerializer や JavaScriptSerializer などのコンポーネントがあります。 JSON.NET のようなサードパーティのライブラリを使用することもできます。

2
MarkJ

これは古い投稿であると理解していますが、最近、古いVB6アプリにWebサービスの消費を追加しているときにつまずきました。受け入れられた回答（VB-JSON）はまだ有効であり、機能しているように見えます。しかし、ChilkatがRESTおよびJSON機能を含むように更新されていることを発見しました。貼り付けられたJSONデータを解析します。

JsonObjectリンク

コードジェネレーターリンク

1
DanH

Excel CELLの数式

=JSON2("{mykey:1111, mykey2:{keyinternal1:22.1,keyinternal2:22.2}, mykey3:3333}", "mykey2", "keyinternal2")

ディスプレイ：22.2

=JSON("{mykey:1111,mykey2:2222,mykey3:3333}", "mykey2")

ディスプレイ：2222

  • 指示：
  • ステップ1。 Alt + F11を押す
  • ステップ2。挿入->モジュール
  • ステップ3。ツール->リファレンス-> Microsoft Script Control 1.0にチェック
  • ステップ4。これを下に貼り付けてください。
  • ステップ5。 Alt + Q VBAウィンドウを閉じます。

ツール->参照-> Microsoft Script Control 1.0; {0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}; C：\ Windows\SysWOW64\msscript.ocx

Public Function JSON(sJsonString As String, Key As String) As String
On Error GoTo err_handler

    Dim oScriptEngine As ScriptControl
    Set oScriptEngine = New ScriptControl
    oScriptEngine.Language = "JScript"

    Dim objJSON As Object
    Set objJSON = oScriptEngine.Eval("(" + sJsonString + ")")

    JSON = VBA.CallByName(objJSON, Key, VbGet)

Err_Exit:
    Exit Function

err_handler:
    JSON = "Error: " & Err.Description
    Resume Err_Exit

End Function


Public Function JSON2(sJsonString As String, Key1 As String, Key2 As String) As String
On Error GoTo err_handler

    Dim oScriptEngine As ScriptControl
    Set oScriptEngine = New ScriptControl
    oScriptEngine.Language = "JScript"

    Dim objJSON As Object
    Set objJSON = oScriptEngine.Eval("(" + sJsonString + ")")

    JSON2 = VBA.CallByName(VBA.CallByName(objJSON, Key1, VbGet), Key2, VbGet)

Err_Exit:
    Exit Function

err_handler:
    JSON2 = "Error: " & Err.Description
    Resume Err_Exit

End Function
0
hamish

JSONを解析するJavaScript機能を使用して、ScriptControlの上に、VBAでパーサーを作成し、JSON内のすべてのデータポイントをリストできます。データ構造がどの程度ネストまたは複雑であっても、有効なJSONを提供する限り、このパーサーは完全なツリー構造を返します。

JavaScriptのEval、getKeys、およびgetPropertyメソッドは、JSONを検証および読み取るためのビルディングブロックを提供します。

VBAの再帰関数と組み合わせると、JSON文字列のすべてのキー（最大nレベルまで）を反復処理できます。次に、Treeコントロール（この記事で使用）またはディクショナリ、または単純なワークシートを使用して、必要に応じてJSONデータを配置できます。

完全なVBAコード：JSONを解析するJavaScript機能を使用して、ScriptControlの上に、VBAでパーサーを作成して、JSON内のすべてのデータポイントをリストできます。データ構造がどの程度ネストまたは複雑であっても、有効なJSONを提供する限り、このパーサーは完全なツリー構造を返します。

JavaScriptのEval、getKeys、およびgetPropertyメソッドは、JSONを検証および読み取るためのビルディングブロックを提供します。

VBAの再帰関数と組み合わせると、JSON文字列のすべてのキー（最大nレベルまで）を反復処理できます。次に、Treeコントロール（この記事で使用）またはディクショナリ、または単純なワークシートを使用して、必要に応じてJSONデータを配置できます。

ここに完全なVBAコード

0
cyboashu

これはvb6のサンプルコードで、テスト済みです。

上記の良い例から、変更を加えてこの良い結果を得ました

キー{}および配列[]を読み取ることができます

Option Explicit
'in vb6 click "Tools"->"References" then
'check the box "Microsoft Script Control 1.0";
Dim oScriptEngine As New ScriptControl
Dim objJSON As Object

''to use it
Private Sub Command1_Click()
  MsgBox JsonGet("key1", "{'key1': 'value1'  ,'key2': { 'key3': 'value3' } }")''returns "value1"
  MsgBox JsonGet("key2.key3", "{'key1': 'value1'  ,'key2': { 'key3': 'value3' } }") ''returns "value3"
  MsgBox JsonGet("result.0.Ask", "{'result':[{'MarketName':'BTC-1ST','Bid':0.00004718,'Ask':0.00004799},{'MarketName':'BTC-2GIVE','Bid':0.00000073,'Ask':0.00000074}]}") ''returns "0.00004799"
  MsgBox JsonGet("mykey2.keyinternal1", "{mykey:1111, mykey2:{keyinternal1:22.1,keyinternal2:22.2}, mykey3:3333}") ''returns "22.1"
End Sub

Public Function JsonGet(eKey$, eJsonString$, Optional eDlim$ = ".") As String
  Dim tmp$()
  Static sJsonString$
  If Trim(eKey$) = "" Or Trim(eJsonString$) = "" Then Exit Function
  If sJsonString <> eJsonString Then
    sJsonString = eJsonString
    oScriptEngine.Language = "JScript"
    Set objJSON = oScriptEngine.Eval("(" + eJsonString + ")")
  End If
  tmp = Split(eKey, eDlim)
  If UBound(tmp) = 0 Then JsonGet = VBA.CallByName(objJSON, eKey, VbGet): Exit Function

  Dim i&, o As Object
  Set o = objJSON
  For i = 0 To UBound(tmp) - 1
    Set o = VBA.CallByName(o, tmp(i), VbGet)
  Next i
  JsonGet = VBA.CallByName(o, tmp(i), VbGet)
  Set o = Nothing
End Function

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  Set objJSON = Nothing
End Sub
0
remon78eg