VBA Json 파싱

VBA JSON 파싱

VBA 에서 JSON 파싱할 일이 생겼는데 인터넷에서 상당히 고품질의 코드를 얻어 와서 기록을 남깁니다. 

아래 코드 입니다. 

참조 : https://code.i-harness.com/ko-kr/q/2a737c

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