3
Dim
objJson
As
Object
4
'
With CreateObject("msscriptcontrol.scriptcontrol") '在64位office里可能无法创建此对象,所以使用x86的方法
5
With
CreateObjectx86(
"
msscriptcontrol.scriptcontrol
"
)
7
.Language =
"
javascript
"
8
.addcode
"
var mydata =
"
&
strJson
9
Set
objJson =
.codeobject
10
End
With
11
Set
parseScript =
objJson
13
End Function
15
Function
parseJson()
17
Dim
objJson
As
Object
18
Set
objJson = parseScript(
"
[{""name"":""choco"",""age"":21},{""name"":""anne"",""age"":27}],{""name"":""heming"",""age"":44}]
"
)
20
Dim
objItem
21
For
Each
objItem
In
objJson.mydata
22
Debug.Print
CallByName
(objItem,
"
name
"
, VbGet)
23
Debug.Print
CallByName
(objItem,
"
age
"
, VbGet)
24
Next
26
End Function
28
Function
CreateObjectx86(
Optional
sProgID,
Optional
bClose =
False
)
29
Static
oWnd
As
Object
30
Dim
bRunning
As
Boolean
31
#
If
Win64
Then
32
bRunning =
InStr
(
TypeName
(oWnd),
"
HTMLWindow
"
) >
0
33
If
bClose
Then
34
If
bRunning
Then
oWnd.Close
35
Exit Function
36
End
If
37
If
Not
bRunning
Then
38
Set
oWnd =
CreateWindow()
39
oWnd.execScript
"
Function CreateObjectx86(sProgID): Set CreateObjectx86 = CreateObject(sProgID): End Function
"
,
"
VBScript
"
40
End
If
41
Set
CreateObjectx86 =
oWnd.CreateObjectx86(sProgID)
42
#
Else
43
Set
CreateObjectx86 =
CreateObject
(
"
MSScriptControl.ScriptControl
"
)
44
#
End
If
45
End Function
48
Function
CreateWindow()
49
Dim
sSignature, oShellWnd, oProc
50
On
Error
Resume
Next
51
sSignature =
Left
(
CreateObject
(
"
Scriptlet.TypeLib
"
).GUID,
38
)
52
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
53
Do
54
For
Each
oShellWnd
In
CreateObject
(
"
Shell.Application
"
).Windows
55
Set
CreateWindow =
oShellWnd.GetProperty(sSignature)
56
If
Err.Number =
0
Then
Exit Function
57
Err.Clear
58
Next
59
Loop
60
End Function
