JSON 파싱 함수 :: ParseJSON 명령문 사용법

Function ParseJSON(strJSON, strToParse, Optional strID, Optional strToRemove) As Variant
 
'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ ParseJSON 함수
'▶ strJSON 데이터에서 선택한 데이터 값만 추출합니다.
'▶ 인수 설명
'_____________strJSON            : JSON 데이터입니다.
'_____________strToParse        : JSON 추출할 데이터 필드명입니다. 쉼표(,)로 구분하여 입력합니다.
'_____________strID                 : 추출한 데이터 배열의 열에 추가할 ID 입니다. (선택인수)
'_____________strToRemove   : 추출한 데이터에서 제거할 문자열입니다. 쉼표(,)로 구분하여 입력합니다.
'▶ 사용 예제
'Dim v As Variant
'v = ParseJSON(JsonData, "Date, Name, Item")
'###############################################################
 
'----------------------------------------------------
'변수 설정
'----------------------------------------------------
Dim vaToParse As Variant: Dim vToParse As Variant
Dim vaToRemove As Variant: Dim vToRemove As Variant
Dim lngStart As Long
Dim objItm As Variant: Dim strItm As String: Dim tmpItm As String
Dim itmCnt As Long
Dim i As Long: Dim r As Long: Dim c As Long
Dim dicItm As Object
Dim vaItm As Variant: Dim vaItems As Variant: Dim vaReturn As Variant
Dim iCol As Long: Dim maxCol As Long: Dim j As Long
 
Set dicItm = CreateObject("Scripting.Dictionary")
 
'----------------------------------------------------
'JSON 쿼리 분할
'----------------------------------------------------
vaToParse = Split(strToParse, ",")
If Not IsMissing(strToRemove) Then vaToRemove = Split(strToRemove, ",")
 
lngStart = InStr(1, strJSON, "[")
strJSON = Right(strJSON, Len(strJSON) - lngStart)
 
'/*----내부 JSON 구문 제거---*/
strJSON = Replace(strJSON, "{\", "|\")
strJSON = Replace(strJSON, "\""}", "\""^")
'------------------------------------
 
objItm = Split(strJSON, "{")
 
itmCnt = UBound(objItm)
 
For i = 1 To itmCnt
    strItm = Split(objItm(i), "}")(0)
    strItm = Trim(strItm)
    '/*-----------각 항목 줄바꿈으로 구분될 경우 줄바꿈 제거----------*/
        Dim regEx As Object
        Set regEx = CreateObject("VBScript.RegExp")
        regEx.Pattern = "(,\n\s+" & Chr(34) & ")"
        regEx.Global = True
        strItm = regEx.Replace(strItm, "," & Chr(34))
    '-----------------------------------------------------------------------------
    If Left(strItm, 1) = """" Then strItm = Right(strItm, Len(strItm) - 1)
    If Right(strItm, 1) = """" Then strItm = Left(strItm, Len(strItm) - 1)
     iCol = Len(strItm) - Len(Replace(strItm, ":", ""))
    If iCol > maxCol Then maxCol = iCol
 
    If Not IsMissing(strID) Then
        If strID <> "" Then
            ReDim vaItm(0 To iCol)
            vaItm(0) = strID: j = 1
        Else
            ReDim vaItm(0 To iCol - 1)
            j = 0
        End If
    Else
        ReDim vaItm(0 To iCol - 1)
        j = 0
    End If
 
    On Error Resume Next
    For Each vToParse In vaToParse
        If InStr(strItm, Trim(vToParse) & """:") > 0 Then
            strItm = Replace(strItm, "," & vbNewLine & """", ",""")
            tmpItm = Split(strItm, Trim(vToParse) & """:")(1)
            tmpItm = Split(tmpItm, ",""")(0)
            tmpItm = Trim(tmpItm)
            If Left(tmpItm, 1) = """" Then tmpItm = Right(tmpItm, Len(tmpItm) - 1)
            If Right(tmpItm, 1) = """" Then tmpItm = Left(tmpItm, Len(tmpItm) - 1)
            tmpItm = Replace(tmpItm, "< ", "")
            If Not IsMissing(strToRemove) Then
                For Each vToRemove In vaToRemove
                    tmpItm = Replace(tmpItm, Trim(vToRemove), "")
                Next
            End If
            vaItm(j) = tmpItm
        ElseIf InStr(strItm, Trim(vToParse) & ":") > 0 Then
            tmpItm = Split(strItm, Trim(vToParse) & ":")(1)
            tmpItm = Split(tmpItm, ",")(0)
            tmpItm = Replace(tmpItm, vbTab, "")
            tmpItm = Trim(tmpItm)
            Do While Right(tmpItm, 1) = vbLf
                tmpItm = Left(tmpItm, Len(tmpItm) - 1)
            Loop
            If Left(tmpItm, 1) = """" Then tmpItm = Right(tmpItm, Len(tmpItm) - 1)
            If Right(tmpItm, 1) = """" Then tmpItm = Left(tmpItm, Len(tmpItm) - 1)
            tmpItm = Replace(tmpItm, "< ", "")
            If Not IsMissing(strToRemove) Then
                For Each vToRemove In vaToRemove
                    tmpItm = Replace(tmpItm, Trim(vToRemove), "")
                Next
            End If
            vaItm(j) = tmpItm
        End If
        j = j + 1
    Next
    On Error GoTo 0
    dicItm.Add i, Array(vaItm, 1)
Next
 
'----------------------------------------------------
'Dictionary -> 배열 변환
'----------------------------------------------------
r = dicItm.Count
c = UBound(vaToParse) + 1
If Not IsMissing(strID) Then
    If strID <> "" Then c = c + 1
End If
 
If r = 0 Then ParseJSON = "" : Exit Function
 
vaItems = dicItm.Items
 
ReDim vaReturn(1 To r, 1 To c)
 
On Error Resume Next
For i = 0 To r - 1
    For j = 0 To c - 1
        tmpItm = vaItems(i)(0)(j)
        If IsNumeric(tmpItm) And Left(tmpItm, 1) <> 0 Then vaReturn(i + 1, j + 1) = CDbl(tmpItm) Else vaReturn(i + 1, j + 1) = tmpItm
    Next
Next
On Error GoTo 0
 
'----------------------------------------------------
'결과값 리턴
'----------------------------------------------------
ParseJSON = vaReturn
 
End Function