Voici une bibliothèque VB JSON "native".
Il est possible d'utiliser JSON qui est déjà dans IE8+. Ainsi, vous ne dépendez pas d'une bibliothèque tierce qui n'est plus à jour et qui n'est pas testée.
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
Vous pouvez établir une passerelle vers IE.JSON à partir de VB.
Créer une fonction 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
Votez plus haut si vous trouvez utile
0 votes
J'ai une réponse ci-dessous mais j'ai maintenant trouvé une meilleure méthode. exceldevelopmentplatform.blogspot.com/2018/01/