Import chuỗi JSON vào Excel

batman1 · 11/6/18

AutoReply đã viết:
Vâng, mình rất thích được nghe những người tài như anh chỉ dạy. Ước gì em được xem cách làm bài bản sẽ ra sao. Thật sự thì những bài ở trên em nghĩ sao làm vậy thôi chứ không tham khảo gì các tài liệu bài bản hết. Anh giúp em nhá.

Thứ nhất tôi không phải người tài. Thứ hai là chưa chắc tôi làm bài bản. Nhiều khi tình cờ biết một cái gì đó, chưa hẳn là sẽ chuẩn.
Nếu nói như bạn thì tôi xấu hổ lắm không dám múa rìu đâu.
Tranh luận mà cứ dùng những từ ngữ như thế thì ai dám tranh luận? Ai dám cho là mình sẽ làm đúng bài bản, là tài giỏi, khi mà lĩnh vực bao la và mình chỉ nắm được một khía cạnh nhỏ?

AutoReply · 11/6/18

batman1 đã viết:
Thứ nhất tôi không phải người tài. Thứ hai là chưa chắc tôi làm bài bản. Nhiều khi tình cờ biết một cái gì đó, chưa hẳn là sẽ chuẩn.
Nếu nói như bạn thì tôi xấu hổ lắm không dám múa rìu đâu.
Tranh luận mà cứ dùng những từ ngữ như thế thì ai dám tranh luận? Ai dám cho là mình sẽ làm đúng bài bản, là tài giỏi, khi mà lĩnh vực bao la và mình chỉ nắm được một khía cạnh nhỏ?

Em không tranh luận với anh, em cảm thấy thích thú khi được học những phương án tối ưu hơn cách của mình, em thực sự muốn biết nếu không dùng Dictionary và Class Module thì ta sẽ dùng cách gì ? Không cần phải bài bản, đơn giản : ngẫu hứng và vui vẻ, vậy thôi.

batman1 · 11/6/18

AutoReply đã viết:
Em không tranh luận với anh, em cảm thấy thích thú khi được học những phương án tối ưu hơn cách của mình,

Tôi không nói cách của tôi là tối ưu hơn cách của bạn. Tôi viết rất rõ, bạn đừng làm hiểu lầm thế.
Tôi chỉ nói là có thể làm khác. Tôi không nói là cái cách khác này là hay hơn, tối ưu hơn. Nó chỉ là một cách khác thôi.

em thực sự muốn biết nếu không dùng Dictionary và Class Module thì ta sẽ dùng cách gì ? Không cần phải bài bản, đơn giản : ngẫu hứng và vui vẻ, vậy thôi.

Nếu thế thì tôi nêu ý tưởng. Về cách xử lý thì tôi nghĩ có thể cải tiến, tối ưu. Nếu bạn cải tiến và tối ưu thì hay quá.

Thực ra tôi chỉ muốn biết nhiều cách cho đầu óc mở mang mà thôi. Một cái class nhỏ thì vướng bận gì đâu. Chỉ là muốn học thêm các cách khác mà thôi.

kuldokk · 11/6/18

Ai muốn parse JSON trong Excel có thể tham khảo thư viện này, không cần xài ScriptControl :

Mã:

Attribute VB_Name = "JsonConverter"
''
' VBA-JSON v2.3.0
' (c) Tim Hall - https://github.com/VBA-tools/VBA-JSON
'
' JSON Converter for VBA
'
' Errors:
' 10001 - JSON parse error
'
' @class JsonConverter
' @author tim.hall.engr@gmail.com
' @license MIT (http://www.opensource.org/licenses/mit-license.php)
'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
'
' Based originally on vba-json (with extensive changes)
' BSD license included below
'
' JSONLib, http://code.google.com/p/vba-json/
'
' Copyright (c) 2013, Ryo Yokoyama
' All rights reserved.
'
' Redistribution and use in source and binary forms, with or without
' modification, are permitted provided that the following conditions are met:
'     * Redistributions of source code must retain the above copyright
'       notice, this list of conditions and the following disclaimer.
'     * Redistributions in binary form must reproduce the above copyright
'       notice, this list of conditions and the following disclaimer in the
'       documentation and/or other materials provided with the distribution.
'     * Neither the name of the <organization> nor the
'       names of its contributors may be used to endorse or promote products
'       derived from this software without specific prior written permission.
'
' THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
' ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
' WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
' DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY
' DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
' (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
' LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
' ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
' (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
' SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
Option Explicit

' === VBA-UTC Headers
#If Mac Then

#If VBA7 Then

' 64-bit Mac (2016)
Private Declare PtrSafe Function utc_popen Lib "libc.dylib" Alias "popen" _
    (ByVal utc_Command As String, ByVal utc_Mode As String) As LongPtr
Private Declare PtrSafe Function utc_pclose Lib "libc.dylib" Alias "pclose" _
    (ByVal utc_File As LongPtr) As LongPtr
Private Declare PtrSafe Function utc_fread Lib "libc.dylib" Alias "fread" _
    (ByVal utc_Buffer As String, ByVal utc_Size As LongPtr, ByVal utc_Number As LongPtr, ByVal utc_File As LongPtr) As LongPtr
Private Declare PtrSafe Function utc_feof Lib "libc.dylib" Alias "feof" _
    (ByVal utc_File As LongPtr) As LongPtr

#Else

' 32-bit Mac
Private Declare Function utc_popen Lib "libc.dylib" Alias "popen" _
    (ByVal utc_Command As String, ByVal utc_Mode As String) As Long
Private Declare Function utc_pclose Lib "libc.dylib" Alias "pclose" _
    (ByVal utc_File As Long) As Long
Private Declare Function utc_fread Lib "libc.dylib" Alias "fread" _
    (ByVal utc_Buffer As String, ByVal utc_Size As Long, ByVal utc_Number As Long, ByVal utc_File As Long) As Long
Private Declare Function utc_feof Lib "libc.dylib" Alias "feof" _
    (ByVal utc_File As Long) As Long

#End If

#ElseIf VBA7 Then

' http://msdn.microsoft.com/en-us/library/windows/desktop/ms724421.aspx
' http://msdn.microsoft.com/en-us/library/windows/desktop/ms724949.aspx
' http://msdn.microsoft.com/en-us/library/windows/desktop/ms725485.aspx
Private Declare PtrSafe Function utc_GetTimeZoneInformation Lib "kernel32" Alias "GetTimeZoneInformation" _
    (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION) As Long
Private Declare PtrSafe Function utc_SystemTimeToTzSpecificLocalTime Lib "kernel32" Alias "SystemTimeToTzSpecificLocalTime" _
    (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpUniversalTime As utc_SYSTEMTIME, utc_lpLocalTime As utc_SYSTEMTIME) As Long
Private Declare PtrSafe Function utc_TzSpecificLocalTimeToSystemTime Lib "kernel32" Alias "TzSpecificLocalTimeToSystemTime" _
    (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpLocalTime As utc_SYSTEMTIME, utc_lpUniversalTime As utc_SYSTEMTIME) As Long

#Else

Private Declare Function utc_GetTimeZoneInformation Lib "kernel32" Alias "GetTimeZoneInformation" _
    (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION) As Long
Private Declare Function utc_SystemTimeToTzSpecificLocalTime Lib "kernel32" Alias "SystemTimeToTzSpecificLocalTime" _
    (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpUniversalTime As utc_SYSTEMTIME, utc_lpLocalTime As utc_SYSTEMTIME) As Long
Private Declare Function utc_TzSpecificLocalTimeToSystemTime Lib "kernel32" Alias "TzSpecificLocalTimeToSystemTime" _
    (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpLocalTime As utc_SYSTEMTIME, utc_lpUniversalTime As utc_SYSTEMTIME) As Long

#End If

#If Mac Then

#If VBA7 Then
Private Type utc_ShellResult
    utc_Output As String
    utc_ExitCode As LongPtr
End Type

#Else

Private Type utc_ShellResult
    utc_Output As String
    utc_ExitCode As Long
End Type

#End If

#Else

Private Type utc_SYSTEMTIME
    utc_wYear As Integer
    utc_wMonth As Integer
    utc_wDayOfWeek As Integer
    utc_wDay As Integer
    utc_wHour As Integer
    utc_wMinute As Integer
    utc_wSecond As Integer
    utc_wMilliseconds As Integer
End Type

Private Type utc_TIME_ZONE_INFORMATION
    utc_Bias As Long
    utc_StandardName(0 To 31) As Integer
    utc_StandardDate As utc_SYSTEMTIME
    utc_StandardBias As Long
    utc_DaylightName(0 To 31) As Integer
    utc_DaylightDate As utc_SYSTEMTIME
    utc_DaylightBias As Long
End Type

#End If
' === End VBA-UTC

Private Type json_Options
    ' VBA only stores 15 significant digits, so any numbers larger than that are truncated
    ' This can lead to issues when BIGINT's are used (e.g. for Ids or Credit Cards), as they will be invalid above 15 digits
    ' See: http://support.microsoft.com/kb/269370
    '
    ' By default, VBA-JSON will use String for numbers longer than 15 characters that contain only digits
    ' to override set `JsonConverter.JsonOptions.UseDoubleForLargeNumbers = True`
    UseDoubleForLargeNumbers As Boolean

    ' The JSON standard requires object keys to be quoted (" or '), use this option to allow unquoted keys
    AllowUnquotedKeys As Boolean

    ' The solidus (/) is not required to be escaped, use this option to escape them as \/ in ConvertToJson
    EscapeSolidus As Boolean
End Type
Public JsonOptions As json_Options

' ============================================= '
' Public Methods
' ============================================= '

''
' Convert JSON string to object (Dictionary/Collection)
'
' @method ParseJson
' @param {String} json_String
' @return {Object} (Dictionary or Collection)
' @throws 10001 - JSON parse error
''
Public Function ParseJson(ByVal JsonString As String) As Object
    Dim json_Index As Long
    json_Index = 1

    ' Remove vbCr, vbLf, and vbTab from json_String
    JsonString = VBA.Replace(VBA.Replace(VBA.Replace(JsonString, VBA.vbCr, ""), VBA.vbLf, ""), VBA.vbTab, "")

    json_SkipSpaces JsonString, json_Index
    Select Case VBA.Mid$(JsonString, json_Index, 1)
    Case "{"
        Set ParseJson = json_ParseObject(JsonString, json_Index)
    Case "["
        Set ParseJson = json_ParseArray(JsonString, json_Index)
    Case Else
        ' Error: Invalid JSON string
        Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(JsonString, json_Index, "Expecting '{' or '['")
    End Select
End Function

''
' Convert object (Dictionary/Collection/Array) to JSON
'
' @method ConvertToJson
' @param {Variant} JsonValue (Dictionary, Collection, or Array)
' @param {Integer|String} Whitespace "Pretty" print json with given number of spaces per indentation (Integer) or given string
' @return {String}
''
Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitespace As Variant, Optional ByVal json_CurrentIndentation As Long = 0) As String
    Dim json_Buffer As String
    Dim json_BufferPosition As Long
    Dim json_BufferLength As Long
    Dim json_Index As Long
    Dim json_LBound As Long
    Dim json_UBound As Long
    Dim json_IsFirstItem As Boolean
    Dim json_Index2D As Long
    Dim json_LBound2D As Long
    Dim json_UBound2D As Long
    Dim json_IsFirstItem2D As Boolean
    Dim json_Key As Variant
    Dim json_Value As Variant
    Dim json_DateStr As String
    Dim json_Converted As String
    Dim json_SkipItem As Boolean
    Dim json_PrettyPrint As Boolean
    Dim json_Indentation As String
    Dim json_InnerIndentation As String

    json_LBound = -1
    json_UBound = -1
    json_IsFirstItem = True
    json_LBound2D = -1
    json_UBound2D = -1
    json_IsFirstItem2D = True
    json_PrettyPrint = Not IsMissing(Whitespace)

    Select Case VBA.VarType(JsonValue)
    Case VBA.vbNull
        ConvertToJson = "null"
    Case VBA.vbDate
        ' Date
        json_DateStr = ConvertToIso(VBA.CDate(JsonValue))

        ConvertToJson = """" & json_DateStr & """"
    Case VBA.vbString
        ' String (or large number encoded as string)
        If Not JsonOptions.UseDoubleForLargeNumbers And json_StringIsLargeNumber(JsonValue) Then
            ConvertToJson = JsonValue
        Else
            ConvertToJson = """" & json_Encode(JsonValue) & """"
        End If
    Case VBA.vbBoolean
        If JsonValue Then
            ConvertToJson = "true"
        Else
            ConvertToJson = "false"
        End If
    Case VBA.vbArray To VBA.vbArray + VBA.vbByte
        If json_PrettyPrint Then
            If VBA.VarType(Whitespace) = VBA.vbString Then
                json_Indentation = VBA.String$(json_CurrentIndentation + 1, Whitespace)
                json_InnerIndentation = VBA.String$(json_CurrentIndentation + 2, Whitespace)
            Else
                json_Indentation = VBA.Space$((json_CurrentIndentation + 1) * Whitespace)
                json_InnerIndentation = VBA.Space$((json_CurrentIndentation + 2) * Whitespace)
            End If
        End If

        ' Array
        json_BufferAppend json_Buffer, "[", json_BufferPosition, json_BufferLength

        On Error Resume Next

        json_LBound = LBound(JsonValue, 1)
        json_UBound = UBound(JsonValue, 1)
        json_LBound2D = LBound(JsonValue, 2)
        json_UBound2D = UBound(JsonValue, 2)

        If json_LBound >= 0 And json_UBound >= 0 Then
            For json_Index = json_LBound To json_UBound
                If json_IsFirstItem Then
                    json_IsFirstItem = False
                Else
                    ' Append comma to previous line
                    json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength
                End If

                If json_LBound2D >= 0 And json_UBound2D >= 0 Then
                    ' 2D Array
                    If json_PrettyPrint Then
                        json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength
                    End If
                    json_BufferAppend json_Buffer, json_Indentation & "[", json_BufferPosition, json_BufferLength

                    For json_Index2D = json_LBound2D To json_UBound2D
                        If json_IsFirstItem2D Then
                            json_IsFirstItem2D = False
                        Else
                            json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength
                        End If

                        json_Converted = ConvertToJson(JsonValue(json_Index, json_Index2D), Whitespace, json_CurrentIndentation + 2)

                        ' For Arrays/Collections, undefined (Empty/Nothing) is treated as null
                        If json_Converted = "" Then
                            ' (nest to only check if converted = "")
                            If json_IsUndefined(JsonValue(json_Index, json_Index2D)) Then
                                json_Converted = "null"
                            End If
                        End If

                        If json_PrettyPrint Then
                            json_Converted = vbNewLine & json_InnerIndentation & json_Converted
                        End If

                        json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength
                    Next json_Index2D

                    If json_PrettyPrint Then
                        json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength
                    End If

                    json_BufferAppend json_Buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength
                    json_IsFirstItem2D = True
                Else
                    ' 1D Array
                    json_Converted = ConvertToJson(JsonValue(json_Index), Whitespace, json_CurrentIndentation + 1)

                    ' For Arrays/Collections, undefined (Empty/Nothing) is treated as null
                    If json_Converted = "" Then
                        ' (nest to only check if converted = "")
                        If json_IsUndefined(JsonValue(json_Index)) Then
                            json_Converted = "null"
                        End If
                    End If

                    If json_PrettyPrint Then
                        json_Converted = vbNewLine & json_Indentation & json_Converted
                    End If

                    json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength
                End If
            Next json_Index
        End If

        On Error GoTo 0

        If json_PrettyPrint Then
            json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength

            If VBA.VarType(Whitespace) = VBA.vbString Then
                json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace)
            Else
                json_Indentation = VBA.Space$(json_CurrentIndentation * Whitespace)
            End If
        End If

        json_BufferAppend json_Buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength

        ConvertToJson = json_BufferToString(json_Buffer, json_BufferPosition)

    ' Dictionary or Collection
    Case VBA.vbObject
        If json_PrettyPrint Then
            If VBA.VarType(Whitespace) = VBA.vbString Then
                json_Indentation = VBA.String$(json_CurrentIndentation + 1, Whitespace)
            Else
                json_Indentation = VBA.Space$((json_CurrentIndentation + 1) * Whitespace)
            End If
        End If

        ' Dictionary
        If VBA.TypeName(JsonValue) = "Dictionary" Then
            json_BufferAppend json_Buffer, "{", json_BufferPosition, json_BufferLength
            For Each json_Key In JsonValue.Keys
                ' For Objects, undefined (Empty/Nothing) is not added to object
                json_Converted = ConvertToJson(JsonValue(json_Key), Whitespace, json_CurrentIndentation + 1)
                If json_Converted = "" Then
                    json_SkipItem = json_IsUndefined(JsonValue(json_Key))
                Else
                    json_SkipItem = False
                End If

                If Not json_SkipItem Then
                    If json_IsFirstItem Then
                        json_IsFirstItem = False
                    Else
                        json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength
                    End If

                    If json_PrettyPrint Then
                        json_Converted = vbNewLine & json_Indentation & """" & json_Key & """: " & json_Converted
                    Else
                        json_Converted = """" & json_Key & """:" & json_Converted
                    End If

                    json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength
                End If
            Next json_Key

            If json_PrettyPrint Then
                json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength

                If VBA.VarType(Whitespace) = VBA.vbString Then
                    json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace)
                Else
                    json_Indentation = VBA.Space$(json_CurrentIndentation * Whitespace)
                End If
            End If

            json_BufferAppend json_Buffer, json_Indentation & "}", json_BufferPosition, json_BufferLength

        ' Collection
        ElseIf VBA.TypeName(JsonValue) = "Collection" Then
            json_BufferAppend json_Buffer, "[", json_BufferPosition, json_BufferLength
            For Each json_Value In JsonValue
                If json_IsFirstItem Then
                    json_IsFirstItem = False
                Else
                    json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength
                End If

                json_Converted = ConvertToJson(json_Value, Whitespace, json_CurrentIndentation + 1)

                ' For Arrays/Collections, undefined (Empty/Nothing) is treated as null
                If json_Converted = "" Then
                    ' (nest to only check if converted = "")
                    If json_IsUndefined(json_Value) Then
                        json_Converted = "null"
                    End If
                End If

                If json_PrettyPrint Then
                    json_Converted = vbNewLine & json_Indentation & json_Converted
                End If

                json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength
            Next json_Value

            If json_PrettyPrint Then
                json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength

                If VBA.VarType(Whitespace) = VBA.vbString Then
                    json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace)
                Else
                    json_Indentation = VBA.Space$(json_CurrentIndentation * Whitespace)
                End If
            End If

            json_BufferAppend json_Buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength
        End If

        ConvertToJson = json_BufferToString(json_Buffer, json_BufferPosition)
    Case VBA.vbInteger, VBA.vbLong, VBA.vbSingle, VBA.vbDouble, VBA.vbCurrency, VBA.vbDecimal
        ' Number (use decimals for numbers)
        ConvertToJson = VBA.Replace(JsonValue, ",", ".")
    Case Else
        ' vbEmpty, vbError, vbDataObject, vbByte, vbUserDefinedType
        ' Use VBA's built-in to-string
        On Error Resume Next
        ConvertToJson = JsonValue
        On Error GoTo 0
    End Select
End Function

' ============================================= '
' Private Functions
' ============================================= '

Private Function json_ParseObject(json_String As String, ByRef json_Index As Long) As Dictionary
    Dim json_Key As String
    Dim json_NextChar As String

    Set json_ParseObject = New Dictionary
    json_SkipSpaces json_String, json_Index
    If VBA.Mid$(json_String, json_Index, 1) <> "{" Then
        Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting '{'")
    Else
        json_Index = json_Index + 1

        Do
            json_SkipSpaces json_String, json_Index
            If VBA.Mid$(json_String, json_Index, 1) = "}" Then
                json_Index = json_Index + 1
                Exit Function
            ElseIf VBA.Mid$(json_String, json_Index, 1) = "," Then
                json_Index = json_Index + 1
                json_SkipSpaces json_String, json_Index
            End If

            json_Key = json_ParseKey(json_String, json_Index)
            json_NextChar = json_Peek(json_String, json_Index)
            If json_NextChar = "[" Or json_NextChar = "{" Then
                Set json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index)
            Else
                json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index)
            End If
        Loop
    End If
End Function

Private Function json_ParseArray(json_String As String, ByRef json_Index As Long) As Collection
    Set json_ParseArray = New Collection

    json_SkipSpaces json_String, json_Index
    If VBA.Mid$(json_String, json_Index, 1) <> "[" Then
        Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting '['")
    Else
        json_Index = json_Index + 1

        Do
            json_SkipSpaces json_String, json_Index
            If VBA.Mid$(json_String, json_Index, 1) = "]" Then
                json_Index = json_Index + 1
                Exit Function
            ElseIf VBA.Mid$(json_String, json_Index, 1) = "," Then
                json_Index = json_Index + 1
                json_SkipSpaces json_String, json_Index
            End If

            json_ParseArray.Add json_ParseValue(json_String, json_Index)
        Loop
    End If
End Function

Private Function json_ParseValue(json_String As String, ByRef json_Index As Long) As Variant
    json_SkipSpaces json_String, json_Index
    Select Case VBA.Mid$(json_String, json_Index, 1)
    Case "{"
        Set json_ParseValue = json_ParseObject(json_String, json_Index)
    Case "["
        Set json_ParseValue = json_ParseArray(json_String, json_Index)
    Case """", "'"
        json_ParseValue = json_ParseString(json_String, json_Index)
    Case Else
        If VBA.Mid$(json_String, json_Index, 4) = "true" Then
            json_ParseValue = True
            json_Index = json_Index + 4
        ElseIf VBA.Mid$(json_String, json_Index, 5) = "false" Then
            json_ParseValue = False
            json_Index = json_Index + 5
        ElseIf VBA.Mid$(json_String, json_Index, 4) = "null" Then
            json_ParseValue = Null
            json_Index = json_Index + 4
        ElseIf VBA.InStr("+-0123456789", VBA.Mid$(json_String, json_Index, 1)) Then
            json_ParseValue = json_ParseNumber(json_String, json_Index)
        Else
            Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting 'STRING', 'NUMBER', null, true, false, '{', or '['")
        End If
    End Select
End Function

Private Function json_ParseString(json_String As String, ByRef json_Index As Long) As String
    Dim json_Quote As String
    Dim json_Char As String
    Dim json_Code As String
    Dim json_Buffer As String
    Dim json_BufferPosition As Long
    Dim json_BufferLength As Long

    json_SkipSpaces json_String, json_Index

    ' Store opening quote to look for matching closing quote
    json_Quote = VBA.Mid$(json_String, json_Index, 1)
    json_Index = json_Index + 1

    Do While json_Index > 0 And json_Index <= Len(json_String)
        json_Char = VBA.Mid$(json_String, json_Index, 1)

        Select Case json_Char
        Case "\"
            ' Escaped string, \\, or \/
            json_Index = json_Index + 1
            json_Char = VBA.Mid$(json_String, json_Index, 1)

            Select Case json_Char
            Case """", "\", "/", "'"
                json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength
                json_Index = json_Index + 1
            Case "b"
                json_BufferAppend json_Buffer, vbBack, json_BufferPosition, json_BufferLength
                json_Index = json_Index + 1
            Case "f"
                json_BufferAppend json_Buffer, vbFormFeed, json_BufferPosition, json_BufferLength
                json_Index = json_Index + 1
            Case "n"
                json_BufferAppend json_Buffer, vbCrLf, json_BufferPosition, json_BufferLength
                json_Index = json_Index + 1
            Case "r"
                json_BufferAppend json_Buffer, vbCr, json_BufferPosition, json_BufferLength
                json_Index = json_Index + 1
            Case "t"
                json_BufferAppend json_Buffer, vbTab, json_BufferPosition, json_BufferLength
                json_Index = json_Index + 1
            Case "u"
                ' Unicode character escape (e.g. \u00a9 = Copyright)
                json_Index = json_Index + 1
                json_Code = VBA.Mid$(json_String, json_Index, 4)
                json_BufferAppend json_Buffer, VBA.ChrW(VBA.Val("&h" + json_Code)), json_BufferPosition, json_BufferLength
                json_Index = json_Index + 4
            End Select
        Case json_Quote
            json_ParseString = json_BufferToString(json_Buffer, json_BufferPosition)
            json_Index = json_Index + 1
            Exit Function
        Case Else
            json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength
            json_Index = json_Index + 1
        End Select
    Loop
End Function

Private Function json_ParseNumber(json_String As String, ByRef json_Index As Long) As Variant
    Dim json_Char As String
    Dim json_Value As String
    Dim json_IsLargeNumber As Boolean

    json_SkipSpaces json_String, json_Index

    Do While json_Index > 0 And json_Index <= Len(json_String)
        json_Char = VBA.Mid$(json_String, json_Index, 1)

        If VBA.InStr("+-0123456789.eE", json_Char) Then
            ' Unlikely to have massive number, so use simple append rather than buffer here
            json_Value = json_Value & json_Char
            json_Index = json_Index + 1
        Else
            ' Excel only stores 15 significant digits, so any numbers larger than that are truncated
            ' This can lead to issues when BIGINT's are used (e.g. for Ids or Credit Cards), as they will be invalid above 15 digits
            ' See: http://support.microsoft.com/kb/269370
            '
            ' Fix: Parse -> String, Convert -> String longer than 15/16 characters containing only numbers and decimal points -> Number
            ' (decimal doesn't factor into significant digit count, so if present check for 15 digits + decimal = 16)
            json_IsLargeNumber = IIf(InStr(json_Value, "."), Len(json_Value) >= 17, Len(json_Value) >= 16)
            If Not JsonOptions.UseDoubleForLargeNumbers And json_IsLargeNumber Then
                json_ParseNumber = json_Value
            Else
                ' VBA.Val does not use regional settings, so guard for comma is not needed
                json_ParseNumber = VBA.Val(json_Value)
            End If
            Exit Function
        End If
    Loop
End Function

Private Function json_ParseKey(json_String As String, ByRef json_Index As Long) As String
    ' Parse key with single or double quotes
    If VBA.Mid$(json_String, json_Index, 1) = """" Or VBA.Mid$(json_String, json_Index, 1) = "'" Then
        json_ParseKey = json_ParseString(json_String, json_Index)
    ElseIf JsonOptions.AllowUnquotedKeys Then
        Dim json_Char As String
        Do While json_Index > 0 And json_Index <= Len(json_String)
            json_Char = VBA.Mid$(json_String, json_Index, 1)
            If (json_Char <> " ") And (json_Char <> ":") Then
                json_ParseKey = json_ParseKey & json_Char
                json_Index = json_Index + 1
            Else
                Exit Do
            End If
        Loop
    Else
        Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting '""' or '''")
    End If

    ' Check for colon and skip if present or throw if not present
    json_SkipSpaces json_String, json_Index
    If VBA.Mid$(json_String, json_Index, 1) <> ":" Then
        Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting ':'")
    Else
        json_Index = json_Index + 1
    End If
End Function

Private Function json_IsUndefined(ByVal json_Value As Variant) As Boolean
    ' Empty / Nothing -> undefined
    Select Case VBA.VarType(json_Value)
    Case VBA.vbEmpty
        json_IsUndefined = True
    Case VBA.vbObject
        Select Case VBA.TypeName(json_Value)
        Case "Empty", "Nothing"
            json_IsUndefined = True
        End Select
    End Select
End Function

Private Function json_Encode(ByVal json_Text As Variant) As String
    ' Reference: http://www.ietf.org/rfc/rfc4627.txt
    ' Escape: ", \, /, backspace, form feed, line feed, carriage return, tab
    Dim json_Index As Long
    Dim json_Char As String
    Dim json_AscCode As Long
    Dim json_Buffer As String
    Dim json_BufferPosition As Long
    Dim json_BufferLength As Long

    For json_Index = 1 To VBA.Len(json_Text)
        json_Char = VBA.Mid$(json_Text, json_Index, 1)
        json_AscCode = VBA.AscW(json_Char)

        ' When AscW returns a negative number, it returns the twos complement form of that number.
        ' To convert the twos complement notation into normal binary notation, add 0xFFF to the return result.
        ' https://support.microsoft.com/en-us/kb/272138
        If json_AscCode < 0 Then
            json_AscCode = json_AscCode + 65536
        End If

        ' From spec, ", \, and control characters must be escaped (solidus is optional)

        Select Case json_AscCode
        Case 34
            ' " -> 34 -> \"
            json_Char = "\"""
        Case 92
            ' \ -> 92 -> \\
            json_Char = "\\"
        Case 47
            ' / -> 47 -> \/ (optional)
            If JsonOptions.EscapeSolidus Then
                json_Char = "\/"
            End If
        Case 8
            ' backspace -> 8 -> \b
            json_Char = "\b"
        Case 12
            ' form feed -> 12 -> \f
            json_Char = "\f"
        Case 10
            ' line feed -> 10 -> \n
            json_Char = "\n"
        Case 13
            ' carriage return -> 13 -> \r
            json_Char = "\r"
        Case 9
            ' tab -> 9 -> \t
            json_Char = "\t"
        Case 0 To 31, 127 To 65535
            ' Non-ascii characters -> convert to 4-digit hex
            json_Char = "\u" & VBA.Right$("0000" & VBA.Hex$(json_AscCode), 4)
        End Select

        json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength
    Next json_Index

    json_Encode = json_BufferToString(json_Buffer, json_BufferPosition)
End Function

Private Function json_Peek(json_String As String, ByVal json_Index As Long, Optional json_NumberOfCharacters As Long = 1) As String
    ' "Peek" at the next number of characters without incrementing json_Index (ByVal instead of ByRef)
    json_SkipSpaces json_String, json_Index
    json_Peek = VBA.Mid$(json_String, json_Index, json_NumberOfCharacters)
End Function

Private Sub json_SkipSpaces(json_String As String, ByRef json_Index As Long)
    ' Increment index to skip over spaces
    Do While json_Index > 0 And json_Index <= VBA.Len(json_String) And VBA.Mid$(json_String, json_Index, 1) = " "
        json_Index = json_Index + 1
    Loop
End Sub

Private Function json_StringIsLargeNumber(json_String As Variant) As Boolean
    ' Check if the given string is considered a "large number"
    ' (See json_ParseNumber)

    Dim json_Length As Long
    Dim json_CharIndex As Long
    json_Length = VBA.Len(json_String)

    ' Length with be at least 16 characters and assume will be less than 100 characters
    If json_Length >= 16 And json_Length <= 100 Then
        Dim json_CharCode As String

        json_StringIsLargeNumber = True

        For json_CharIndex = 1 To json_Length
            json_CharCode = VBA.Asc(VBA.Mid$(json_String, json_CharIndex, 1))
            Select Case json_CharCode
            ' Look for .|0-9|E|e
            Case 46, 48 To 57, 69, 101
                ' Continue through characters
            Case Else
                json_StringIsLargeNumber = False
                Exit Function
            End Select
        Next json_CharIndex
    End If
End Function

Private Function json_ParseErrorMessage(json_String As String, ByRef json_Index As Long, ErrorMessage As String)
    ' Provide detailed parse error message, including details of where and what occurred
    '
    ' Example:
    ' Error parsing JSON:
    ' {"abcde":True}
    '          ^
    ' Expecting 'STRING', 'NUMBER', null, true, false, '{', or '['

    Dim json_StartIndex As Long
    Dim json_StopIndex As Long

    ' Include 10 characters before and after error (if possible)
    json_StartIndex = json_Index - 10
    json_StopIndex = json_Index + 10
    If json_StartIndex <= 0 Then
        json_StartIndex = 1
    End If
    If json_StopIndex > VBA.Len(json_String) Then
        json_StopIndex = VBA.Len(json_String)
    End If

    json_ParseErrorMessage = "Error parsing JSON:" & VBA.vbNewLine & _
                             VBA.Mid$(json_String, json_StartIndex, json_StopIndex - json_StartIndex + 1) & VBA.vbNewLine & _
                             VBA.Space$(json_Index - json_StartIndex) & "^" & VBA.vbNewLine & _
                             ErrorMessage
End Function

Private Sub json_BufferAppend(ByRef json_Buffer As String, _
                              ByRef json_Append As Variant, _
                              ByRef json_BufferPosition As Long, _
                              ByRef json_BufferLength As Long)
    ' VBA can be slow to append strings due to allocating a new string for each append
    ' Instead of using the traditional append, allocate a large empty string and then copy string at append position
    '
    ' Example:
    ' Buffer: "abc  "
    ' Append: "def"
    ' Buffer Position: 3
    ' Buffer Length: 5
    '
    ' Buffer position + Append length > Buffer length -> Append chunk of blank space to buffer
    ' Buffer: "abc       "
    ' Buffer Length: 10
    '
    ' Put "def" into buffer at position 3 (0-based)
    ' Buffer: "abcdef    "
    '
    ' Approach based on cStringBuilder from vbAccelerator
    ' http://www.vbaccelerator.com/home/VB/Code/Techniques/RunTime_Debug_Tracing/VB6_Tracer_Utility_zip_cStringBuilder_cls.asp
    '
    ' and clsStringAppend from Philip Swannell
    ' https://github.com/VBA-tools/VBA-JSON/pull/82

    Dim json_AppendLength As Long
    Dim json_LengthPlusPosition As Long

    json_AppendLength = VBA.Len(json_Append)
    json_LengthPlusPosition = json_AppendLength + json_BufferPosition

    If json_LengthPlusPosition > json_BufferLength Then
        ' Appending would overflow buffer, add chunk
        ' (double buffer length or append length, whichever is bigger)
        Dim json_AddedLength As Long
        json_AddedLength = IIf(json_AppendLength > json_BufferLength, json_AppendLength, json_BufferLength)

        json_Buffer = json_Buffer & VBA.Space$(json_AddedLength)
        json_BufferLength = json_BufferLength + json_AddedLength
    End If

    ' Note: Namespacing with VBA.Mid$ doesn't work properly here, throwing compile error:
    ' Function call on left-hand side of assignment must return Variant or Object
    Mid$(json_Buffer, json_BufferPosition + 1, json_AppendLength) = CStr(json_Append)
    json_BufferPosition = json_BufferPosition + json_AppendLength
End Sub

Private Function json_BufferToString(ByRef json_Buffer As String, ByVal json_BufferPosition As Long) As String
    If json_BufferPosition > 0 Then
        json_BufferToString = VBA.Left$(json_Buffer, json_BufferPosition)
    End If
End Function

''
' VBA-UTC v1.0.5
' (c) Tim Hall - https://github.com/VBA-tools/VBA-UtcConverter
'
' UTC/ISO 8601 Converter for VBA
'
' Errors:
' 10011 - UTC parsing error
' 10012 - UTC conversion error
' 10013 - ISO 8601 parsing error
' 10014 - ISO 8601 conversion error
'
' @module UtcConverter
' @author tim.hall.engr@gmail.com
' @license MIT (http://www.opensource.org/licenses/mit-license.php)
'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '

' (Declarations moved to top)

' ============================================= '
' Public Methods
' ============================================= '

''
' Parse UTC date to local date
'
' @method ParseUtc
' @param {Date} UtcDate
' @return {Date} Local date
' @throws 10011 - UTC parsing error
''
Public Function ParseUtc(utc_UtcDate As Date) As Date
    On Error GoTo utc_ErrorHandling

#If Mac Then
    ParseUtc = utc_ConvertDate(utc_UtcDate)
#Else
    Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION
    Dim utc_LocalDate As utc_SYSTEMTIME

    utc_GetTimeZoneInformation utc_TimeZoneInfo
    utc_SystemTimeToTzSpecificLocalTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_UtcDate), utc_LocalDate

    ParseUtc = utc_SystemTimeToDate(utc_LocalDate)
#End If

    Exit Function

utc_ErrorHandling:
    Err.Raise 10011, "UtcConverter.ParseUtc", "UTC parsing error: " & Err.Number & " - " & Err.Description
End Function

''
' Convert local date to UTC date
'
' @method ConvertToUrc
' @param {Date} utc_LocalDate
' @return {Date} UTC date
' @throws 10012 - UTC conversion error
''
Public Function ConvertToUtc(utc_LocalDate As Date) As Date
    On Error GoTo utc_ErrorHandling

#If Mac Then
    ConvertToUtc = utc_ConvertDate(utc_LocalDate, utc_ConvertToUtc:=True)
#Else
    Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION
    Dim utc_UtcDate As utc_SYSTEMTIME

    utc_GetTimeZoneInformation utc_TimeZoneInfo
    utc_TzSpecificLocalTimeToSystemTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_LocalDate), utc_UtcDate

    ConvertToUtc = utc_SystemTimeToDate(utc_UtcDate)
#End If

    Exit Function

utc_ErrorHandling:
    Err.Raise 10012, "UtcConverter.ConvertToUtc", "UTC conversion error: " & Err.Number & " - " & Err.Description
End Function

''
' Parse ISO 8601 date string to local date
'
' @method ParseIso
' @param {Date} utc_IsoString
' @return {Date} Local date
' @throws 10013 - ISO 8601 parsing error
''
Public Function ParseIso(utc_IsoString As String) As Date
    On Error GoTo utc_ErrorHandling

    Dim utc_Parts() As String
    Dim utc_DateParts() As String
    Dim utc_TimeParts() As String
    Dim utc_OffsetIndex As Long
    Dim utc_HasOffset As Boolean
    Dim utc_NegativeOffset As Boolean
    Dim utc_OffsetParts() As String
    Dim utc_Offset As Date

    utc_Parts = VBA.Split(utc_IsoString, "T")
    utc_DateParts = VBA.Split(utc_Parts(0), "-")
    ParseIso = VBA.DateSerial(VBA.CInt(utc_DateParts(0)), VBA.CInt(utc_DateParts(1)), VBA.CInt(utc_DateParts(2)))

    If UBound(utc_Parts) > 0 Then
        If VBA.InStr(utc_Parts(1), "Z") Then
            utc_TimeParts = VBA.Split(VBA.Replace(utc_Parts(1), "Z", ""), ":")
        Else
            utc_OffsetIndex = VBA.InStr(1, utc_Parts(1), "+")
            If utc_OffsetIndex = 0 Then
                utc_NegativeOffset = True
                utc_OffsetIndex = VBA.InStr(1, utc_Parts(1), "-")
            End If

            If utc_OffsetIndex > 0 Then
                utc_HasOffset = True
                utc_TimeParts = VBA.Split(VBA.Left$(utc_Parts(1), utc_OffsetIndex - 1), ":")
                utc_OffsetParts = VBA.Split(VBA.Right$(utc_Parts(1), Len(utc_Parts(1)) - utc_OffsetIndex), ":")

                Select Case UBound(utc_OffsetParts)
                Case 0
                    utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), 0, 0)
                Case 1
                    utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), 0)
                Case 2
                    ' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues
                    utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), Int(VBA.Val(utc_OffsetParts(2))))
                End Select

                If utc_NegativeOffset Then: utc_Offset = -utc_Offset
            Else
                utc_TimeParts = VBA.Split(utc_Parts(1), ":")
            End If
        End If

        Select Case UBound(utc_TimeParts)
        Case 0
            ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), 0, 0)
        Case 1
            ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), 0)
        Case 2
            ' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues
            ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), Int(VBA.Val(utc_TimeParts(2))))
        End Select

        ParseIso = ParseUtc(ParseIso)

        If utc_HasOffset Then
            ParseIso = ParseIso - utc_Offset
        End If
    End If

    Exit Function

utc_ErrorHandling:
    Err.Raise 10013, "UtcConverter.ParseIso", "ISO 8601 parsing error for " & utc_IsoString & ": " & Err.Number & " - " & Err.Description
End Function

''
' Convert local date to ISO 8601 string
'
' @method ConvertToIso
' @param {Date} utc_LocalDate
' @return {Date} ISO 8601 string
' @throws 10014 - ISO 8601 conversion error
''
Public Function ConvertToIso(utc_LocalDate As Date) As String
    On Error GoTo utc_ErrorHandling

    ConvertToIso = VBA.Format$(ConvertToUtc(utc_LocalDate), "yyyy-mm-ddTHH:mm:ss.000Z")

    Exit Function

utc_ErrorHandling:
    Err.Raise 10014, "UtcConverter.ConvertToIso", "ISO 8601 conversion error: " & Err.Number & " - " & Err.Description
End Function

' ============================================= '
' Private Functions
' ============================================= '

#If Mac Then

Private Function utc_ConvertDate(utc_Value As Date, Optional utc_ConvertToUtc As Boolean = False) As Date
    Dim utc_ShellCommand As String
    Dim utc_Result As utc_ShellResult
    Dim utc_Parts() As String
    Dim utc_DateParts() As String
    Dim utc_TimeParts() As String

    If utc_ConvertToUtc Then
        utc_ShellCommand = "date -ur `date -jf '%Y-%m-%d %H:%M:%S' " & _
            "'" & VBA.Format$(utc_Value, "yyyy-mm-dd HH:mm:ss") & "' " & _
            " +'%s'` +'%Y-%m-%d %H:%M:%S'"
    Else
        utc_ShellCommand = "date -jf '%Y-%m-%d %H:%M:%S %z' " & _
            "'" & VBA.Format$(utc_Value, "yyyy-mm-dd HH:mm:ss") & " +0000' " & _
            "+'%Y-%m-%d %H:%M:%S'"
    End If

    utc_Result = utc_ExecuteInShell(utc_ShellCommand)

    If utc_Result.utc_Output = "" Then
        Err.Raise 10015, "UtcConverter.utc_ConvertDate", "'date' command failed"
    Else
        utc_Parts = Split(utc_Result.utc_Output, " ")
        utc_DateParts = Split(utc_Parts(0), "-")
        utc_TimeParts = Split(utc_Parts(1), ":")

        utc_ConvertDate = DateSerial(utc_DateParts(0), utc_DateParts(1), utc_DateParts(2)) + _
            TimeSerial(utc_TimeParts(0), utc_TimeParts(1), utc_TimeParts(2))
    End If
End Function

Private Function utc_ExecuteInShell(utc_ShellCommand As String) As utc_ShellResult
#If VBA7 Then
    Dim utc_File As LongPtr
    Dim utc_Read As LongPtr
#Else
    Dim utc_File As Long
    Dim utc_Read As Long
#End If

    Dim utc_Chunk As String

    On Error GoTo utc_ErrorHandling
    utc_File = utc_popen(utc_ShellCommand, "r")

    If utc_File = 0 Then: Exit Function

    Do While utc_feof(utc_File) = 0
        utc_Chunk = VBA.Space$(50)
        utc_Read = CLng(utc_fread(utc_Chunk, 1, Len(utc_Chunk) - 1, utc_File))
        If utc_Read > 0 Then
            utc_Chunk = VBA.Left$(utc_Chunk, CLng(utc_Read))
            utc_ExecuteInShell.utc_Output = utc_ExecuteInShell.utc_Output & utc_Chunk
        End If
    Loop

utc_ErrorHandling:
    utc_ExecuteInShell.utc_ExitCode = CLng(utc_pclose(utc_File))
End Function

#Else

Private Function utc_DateToSystemTime(utc_Value As Date) As utc_SYSTEMTIME
    utc_DateToSystemTime.utc_wYear = VBA.Year(utc_Value)
    utc_DateToSystemTime.utc_wMonth = VBA.Month(utc_Value)
    utc_DateToSystemTime.utc_wDay = VBA.Day(utc_Value)
    utc_DateToSystemTime.utc_wHour = VBA.Hour(utc_Value)
    utc_DateToSystemTime.utc_wMinute = VBA.Minute(utc_Value)
    utc_DateToSystemTime.utc_wSecond = VBA.Second(utc_Value)
    utc_DateToSystemTime.utc_wMilliseconds = 0
End Function

Private Function utc_SystemTimeToDate(utc_Value As utc_SYSTEMTIME) As Date
    utc_SystemTimeToDate = DateSerial(utc_Value.utc_wYear, utc_Value.utc_wMonth, utc_Value.utc_wDay) + _
        TimeSerial(utc_Value.utc_wHour, utc_Value.utc_wMinute, utc_Value.utc_wSecond)
End Function

#End If

AutoReply · 11/6/18

batman1 đã viết:
Tôi không nói cách của tôi là tối ưu hơn cách của bạn. Tôi viết rất rõ, bạn đừng làm hiểu lầm thế.
Tôi chỉ nói là có thể làm khác. Tôi không nói là cái cách khác này là hay hơn, tối ưu hơn. Nó chỉ là một cách khác thôi.

Nếu thế thì tôi nêu ý tưởng. Về cách xử lý thì tôi nghĩ có thể cải tiến, tối ưu. Nếu bạn cải tiến và tối ưu thì hay quá.

Thực ra tôi chỉ muốn biết nhiều cách cho đầu óc mở mang mà thôi. Một cái class nhỏ thì vướng bận gì đâu. Chỉ là muốn học thêm các cách khác mà thôi.

Ở đây chúng ta biết vấn đề của mình nằm ở đâu, không phải là đi phân tích JSON thành Object, mà là khi có Object JSON rồi làm sao đưa trở lại thành VBA array theo các tiêu chí mà người lập chủ đề này hướng đến:
+Tốc độ cao
+Tùy biến cao

Ta có 2 hướng đi:
1.Trả về cho VBA 1 Object, Object này chứa cấu trúc mà VBA có thể làm việc được ( không bị làm phiền bởi chức năng tự động viết hoa chữ cái đầu)
Hướng này VBA nhận Object xong vẫn phải chạy vòng lặp để điền dữ liệu vào mảng.
Em có biết cách làm của anh, nhưng không đủ kinh nghiệm để biết khi tách chuỗi bởi ký tự "," liệu có an toàn ? nên đã cố tình dùng các thuộc tính vbname an toàn không bị viết hoa, đây gọi là sức nhỏ lựa việc nhỏ.
2.Trả về cho VBA 1 mảng => Đây gọi là "việc ai nấy làm". Vì người này không muốn đụng đến mã Jscript, chỉ cần trả về cho anh ta cái mảng VBA là vui vẻ cả làng. Thực ra thì anh ta yêu cầu rất đúng, mô hình làm việc nhóm nên như vậy.
Chỉ có cái em thắc mắc là không thấy anh ta đề cập đến việc sử dụng Class Module tốc độ có cao không ? (cách này thì anh ta chấm 10 điểm tùy biến). Vì hàm trên Class Module không nằm trên Jscript, và khi chạy nó có phải làm công việc Cast dữ liệu giữa 2 ngôn ngữ chăng ? Nếu có ta lại phải tính tới những việc làm sao để số lần cast dữ liệu là nhỏ nhất.
Nếu có thể mong anh giúp giải đáp những thắc mắc của em.
Nhưng suy cho cùng, em vẫn chọn cách sau cùng của mình, gọi Jscript và trả về đúng cái mảng VBA, những người làm chung họ sẽ dễ thực hiện các bước công việc sau mà không cần biết bước trước đã làm gì.
Cảm ơn anh.

batman1 · 11/6/18

AutoReply đã viết:
Nếu có thể mong anh giúp giải đáp những thắc mắc của em.

Về khoản này thì bạn chắc chắn biết hơn tôi nên bạn tự làm nhé

Nhưng suy cho cùng, em vẫn chọn cách sau cùng của mình, gọi Jscript và trả về đúng cái mảng VBA, những người làm chung họ sẽ dễ thực hiện các bước công việc sau mà không cần biết bước trước đã làm gì.

Thì tôi nêu một cách mà tôi chưa thấy thôi. Tôi chưa bàn tới chuyện tốt hơn hay tối ưu hơn. Bạn đọc lại bài đầu của tôi thì bạn thấy là tôi không viết thế.

Lọc kết quả sau khi trả về thì vẫn gần giống bài #31, chỉ có điều, như tôi đã viết, không dùng ActiveXObject('Scripting.Dictionary'). Thế thôi

ndu96081631 · 12/6/18

kuldokk đã viết:
Ai muốn parse JSON trong Excel có thể tham khảo thư viện này, không cần xài ScriptControl :

Code này tôi có thử qua (bài trươc có đề cập). Ưu điểm là độ tùy biến cao nhưng nhược điểm là tốc độ quá chậm bạn à
------------------------------------------------------------------------

batman1 đã viết:
Tôi không nói cách của tôi là tối ưu hơn cách của bạn. Tôi viết rất rõ, bạn đừng làm hiểu lầm thế.
Tôi chỉ nói là có thể làm khác. Tôi không nói là cái cách khác này là hay hơn, tối ưu hơn. Nó chỉ là một cách khác thôi.
Nếu thế thì tôi nêu ý tưởng. Về cách xử lý thì tôi nghĩ có thể cải tiến, tối ưu. Nếu bạn cải tiến và tối ưu thì hay quá.
Thực ra tôi chỉ muốn biết nhiều cách cho đầu óc mở mang mà thôi. Một cái class nhỏ thì vướng bận gì đâu. Chỉ là muốn học thêm các cách khác mà thôi.

Cách này cũng rất hay anh à. Tốc độ cao nhưng khả năng sẽ bị lỗi chỗ rowcount = ArrObj.Length (chữ length sau khi gõ xong nó tự đổi thành Length). Em sẽ nghiên cứu lại chỗ Length vào chỗ Split(key, ",") xem có trục trặc gì không rồi tính tiếp
------------------------------------------------------------------------
Nhiều giải pháp quá! Mình tha hồ lựa chọn. Hiện tại chỉ đang thử nghiệm với 20 dòng dữ liệu, đợi có dữ liệu thật khoảng vài ngàn dòng mình sẽ test lại lần nữa
Cảm ơn tất cả mọi người đã trợ giúp

VetMini · 12/6/18

AutoReply đã viết:
Ở đây chúng ta biết vấn đề của mình nằm ở đâu, không phải là đi phân tích JSON thành Object, mà là khi có Object JSON rồi làm sao đưa trở lại thành VBA array theo các tiêu chí mà người lập chủ đề này hướng đến:
+Tốc độ cao
+Tùy biến cao

Ta có 2 hướng đi:
1.Trả về cho VBA 1 Object, Object này chứa cấu trúc mà VBA có thể làm việc được ( không bị làm phiền bởi chức năng tự động viết hoa chữ cái đầu)
Hướng này VBA nhận Object xong vẫn phải chạy vòng lặp để điền dữ liệu vào mảng.
Em có biết cách làm của anh, nhưng không đủ kinh nghiệm để biết khi tách chuỗi bởi ký tự "," liệu có an toàn ? nên đã cố tình dùng các thuộc tính vbname an toàn không bị viết hoa, đây gọi là sức nhỏ lựa việc nhỏ.
2.Trả về cho VBA 1 mảng => Đây gọi là "việc ai nấy làm". Vì người này không muốn đụng đến mã Jscript, chỉ cần trả về cho anh ta cái mảng VBA là vui vẻ cả làng. Thực ra thì anh ta yêu cầu rất đúng, mô hình làm việc nhóm nên như vậy.
...

Chuyện tốc độ nó chủ quan, tôi không bàn tới.
Chuyện tuỳ biến thì cả hai đều như nhau. Việc "mô hình làm việc nhóm nên như vậy" không hẳn thiên về hướng 2.
Nếu tôi là quản lý nhóm thì chính tôi lại chọn hướng 1. Hàm VBA nhận mảng vẫn in hệt. Tôi chỉ bảo nhóm của tôi viết thêm 1 hàm nhận Object và chuyển nó thành mảng, xong gọi hàm kia. Về sau này, vì lý do gì đó, cái Object kia phải thay đổi thì tôi chỉ cần chú ý đến cái hàm nhận.
(đó là tôi giả sử cái Object kia là "native" đối với cái hàm sử lý ban đầu. Tức là nó dùng một cấu trúc tương đối tiêu chuẩn, có thể parsed được bởi nhiều ngôn ngữ thông dụng - nếu nó là cái Object đặc biệt cho VBA thì quả là thà exclusive handshake protocol ngay từ đầu cho xong)

AutoReply · 12/6/18

VetMini đã viết:
Chuyện tốc độ nó chủ quan, tôi không bàn tới.
Chuyện tuỳ biến thì cả hai đều như nhau. Việc "mô hình làm việc nhóm nên như vậy" không hẳn thiên về hướng 2.
Nếu tôi là quản lý nhóm thì chính tôi lại chọn hướng 1. Hàm VBA nhận mảng vẫn in hệt. Tôi chỉ bảo nhóm của tôi viết thêm 1 hàm nhận Object và chuyển nó thành mảng, xong gọi hàm kia. Về sau này, vì lý do gì đó, cái Object kia phải thay đổi thì tôi chỉ cần chú ý đến cái hàm nhận.
(đó là tôi giả sử cái Object kia là "native" đối với cái hàm sử lý ban đầu. Tức là nó dùng một cấu trúc tương đối tiêu chuẩn, có thể parsed được bởi nhiều ngôn ngữ thông dụng - nếu nó là cái Object đặc biệt cho VBA thì quả là thà exclusive handshake protocol ngay từ đầu cho xong)

Nó không như nhau. Nếu Object trả về thay đổi cái gì đó mà hàm chuyển Object thành mảng VBA không cần viết lại mới tính là như nhau.
Nhưng thôi tùy cách nghĩ của từng người. Với mình thì không có yêu cầu cao gì cả, làm được việc là được.

VetMini · 12/6/18

AutoReply đã viết:
Nó không như nhau. Nếu Object trả về thay đổi cái gì đó mà hàm chuyển Object thành mảng VBA không cần viết lại mới tính là như nhau.
Nhưng thôi tùy cách nghĩ của từng người. Với mình thì không có yêu cầu cao gì cả, làm được việc là được.

Tôi chỉ nói về cái chỗ "làm việc nhóm". Chứ chuyện cốt kiếc tôi đã không tham dự từ đầu, và chưa hề đọc 1 dòng code nào.
Theo nguyên tắc LT HĐT thì tôi thảy cái wrapper cho LTV viết lại dễ hơn thảy nguyên cái code sử lý. Bên viết cai J code không cần phải biết nhiều về VBA, và bên viết code sử lý cũng không cần biết J gì đó (JScrip[t hay JavaScript?). Chỉ thằng viết cái nối ở giữa mới cần.

kuldokk · 12/6/18

ndu96081631 đã viết:
Code này tôi có thử qua (bài trươc có đề cập). Ưu điểm là độ tùy biến cao nhưng nhược điểm là tốc độ quá chậm bạn à
------------------------------------------------------------------------

Cách này cũng rất hay anh à. Tốc độ cao nhưng khả năng sẽ bị lỗi chỗ rowcount = ArrObj.Length (chữ length sau khi gõ xong nó tự đổi thành Length). Em sẽ nghiên cứu lại chỗ Length vào chỗ Split(key, ",") xem có trục trặc gì không rồi tính tiếp
------------------------------------------------------------------------
Nhiều giải pháp quá! Mình tha hồ lựa chọn. Hiện tại chỉ đang thử nghiệm với 20 dòng dữ liệu, đợi có dữ liệu thật khoảng vài ngàn dòng mình sẽ test lại lần nữa
Cảm ơn tất cả mọi người đã trợ giúp

Anh có thể lên trang này, tự tạo ra 1000 records dữ liệu và lưu dưới dạng JSON để test tốc độ

https://www.mockaroo.com/

batman1 · 13/6/18

AutoReply đã viết:
Nó không như nhau. Nếu Object trả về thay đổi cái gì đó mà hàm chuyển Object thành mảng VBA không cần viết lại mới tính là như nhau.

Ở bài trước sau khi gọi parseData code vẫn cần tới script, vì thế không thể hủy đối tượng ScriptEngine_86.
Bây giờ sau khi gọi parseData ta có thể hủy ngay ScriptEngine_86 vì mọi kết quả đã có trong đối tượng mà ta truyền vào khi gọi parseData. Nhưng đối tượng này ta không phải tạo từ một class bắt buộc phải có. Ta tạo đối tượng từ điển và sau khi gọi parseData thì kết quả có trong từ điển.
Tóm lại là ta không có var dict = new ActiveXObject('Scripting.Dictionary') trong script và cũng không cần thêm class nào cả.

Gọi là nghĩ nhiều cách cho cái đầu khỏi han gỉ. Máy lâu ngày không chạy thì luôn han gỉ, hỏng hóc.

AutoReply · 13/6/18

batman1 đã viết:
Ở bài trước sau khi gọi parseData code vẫn cần tới script, vì thế không thể hủy đối tượng ScriptEngine_86.
Bây giờ sau khi gọi parseData ta có thể hủy ngay ScriptEngine_86 vì mọi kết quả đã có trong đối tượng mà ta truyền vào khi gọi parseData. Nhưng đối tượng này ta không phải tạo từ một class bắt buộc phải có. Ta tạo đối tượng từ điển và sau khi gọi parseData thì kết quả có trong từ điển.
Tóm lại là ta không có var dict = new ActiveXObject('Scripting.Dictionary') trong script và cũng không cần thêm class nào cả.

Gọi là nghĩ nhiều cách cho cái đầu khỏi han gỉ. Máy lâu ngày không chạy thì luôn han gỉ, hỏng hóc.

Cũng vui đấy. Ở trên có đường dẫn tạo ngẫu nhiên JSON text, hôm nay ta sẽ tạo thử chuỗi JSON trên 10000 "dòng" rồi lưu vào file text, rồi đọc JSON trong file text để kiểm nghiệm xem cách nào sẽ nhanh hơn, mình cũng chưa biết bên nào ngon, hôm nay khi nào rảnh sẽ thử. hi hi --=0

AutoReply · 13/6/18

ndu96081631 đã viết:
Nhiều giải pháp quá! Mình tha hồ lựa chọn. Hiện tại chỉ đang thử nghiệm với 20 dòng dữ liệu, đợi có dữ liệu thật khoảng vài ngàn dòng mình sẽ test lại lần nữa
Cảm ơn tất cả mọi người đã trợ giúp

Đã kiểm nghiệm 2 hướng code trên đoạn JSON có 15000 "dòng".
Kết quả:
Dùng Dictionary chứa chuỗi : 5 giây.
Dùng Class Module : 11 giây.

Bên nào ngon hơn đã rõ.
Đúng như mình lo ngại, việc chạy lệnh VBA bên trong code Jscript đã làm Jscript tốn nhiều năng lượng chuyển đổi dữ liệu giữa 2 ngôn ngữ.
Vậy thì hướng đi đúng đắn nhất là cứ nạp chuỗi vào Dictionary, rồi dùng VBA xử lý chuỗi theo cách tổng quát nhất có thể.
Trong file dưới đây mình đã cố gắng lái code anh batman1 theo hướng tổng quát, có lẽ không còn hướng nào tối ưu hơn được.

ndu96081631 · 13/6/18

AutoReply đã viết:
Đã kiểm nghiệm 2 hướng code trên đoạn JSON có 15000 "dòng".
Kết quả:
Dùng Dictionary chứa chuỗi : 5 giây.
Dùng Class Module : 11 giây.

Bên nào ngon hơn đã rõ.
Đúng như mình lo ngại, việc chạy lệnh VBA bên trong code Jscript đã làm Jscript tốn nhiều năng lượng chuyển đổi dữ liệu giữa 2 ngôn ngữ.
Vậy thì hướng đi đúng đắn nhất là cứ nạp chuỗi vào Dictionary, rồi dùng VBA xử lý chuỗi theo cách tổng quát nhất có thể.
Trong file dưới đây mình đã cố gắng lái code anh batman1 theo hướng tổng quát, có lẽ không còn hướng nào tối ưu hơn được.

Máy tính mình cùi bắp, test 2 code cho kết quả như nhau = 18s
Vì file làm việc thật không cần refesh, chỉ nhận giá trị mới ngay khi khởi động và làm việc với các giá trị đó trong toàn bộ phiên làm việc đến khi đóng Excel thì thôi. Vậy nên mình sẽ đưa một phần code lên sub AutoOpen để lấy dữ liệu trước, sau đó thì chỉ còn công đoạn xử lý thôi.
Đã thí nghiệm theo hướng AutoOpen này và kết quả lấy dữ liệu 15000 dòng trong vòng 1s
Cảm ơn bạn!

batman1 · 13/6/18

AutoReply đã viết:
Đã kiểm nghiệm 2 hướng code trên đoạn JSON có 15000 "dòng".
Kết quả:
Dùng Dictionary chứa chuỗi : 5 giây.
Dùng Class Module : 11 giây.

Bên nào ngon hơn đã rõ.

.

Có thể có sự nhầm lẫn.
Tôi test trên máy 16 năm tuổi thì kết quả như sau:

1. Chỉ riêng LoadTextFile ngốn ~50 s ở 2 trường hợp.
2. Đoạn sau LoadTextFile cho tới trước Sheet1.Range("A1:F30000").ClearContents ngốn ~5 s ở 2 trường hợp.

Như thế tốc độ có thể coi là như nhau. Trong đó việc lấy dữ liệu và soạn kết quả vào mảng arr chỉ mất 5 s.

AutoReply · 13/6/18

batman1 đã viết:
Có thể có sự nhầm lẫn.
Tôi test trên máy 16 năm tuổi thì kết quả như sau:

1. Chỉ riêng LoadTextFile ngốn ~50 s ở 2 trường hợp.
2. Đoạn sau LoadTextFile cho tới trước Sheet1.Range("A1:F30000").ClearContents ngốn ~5 s ở 2 trường hợp.

Như thế tốc độ có thể coi là như nhau. Trong đó việc lấy dữ liệu và soạn kết quả vào mảng arr chỉ mất 5 s.

Vậy có lẽ sự khác nhau còn nằm ở hệ điều hành. Em chỉ diễn tả theo những gì mình nghĩ, có thể không chính xác thực tế, nhưng cũng gần như vậy.
Máy 32 bit Tạo Object ScriptControl trong chính process Excel
Máy 64 bit tạo ra 1 Process "Html Application Host" nào đó, Process này lại tạo ra Object ScriptControl. Như vậy Object ScriptControl này không nằm trong process Excel. Dẫn đến việc khi chạy các lệnh trong VBA, nó "thấy lạ" và phải mất công chuyển đổi dữ liệu, dẫn đến khác biệt như trên.

Nói ngoài lề 1 chút. Hàm LoadTextFile là cách ngắn nhất nhưng không nhanh nhất để đọc dữ liệu trong file text đúng không nhỉ ? Nhưng chắc ta không được bàn cái đó ở đây đâu ha. --=0

Cám ơn anh.

ndu96081631 · 17/6/18

Cũng cùng chủ đề nhưng là câu hỏi ngược lại: Có cách nào chuyển 1 table thành chuỗi JSON không?
Đương nhiên, chuyện xử lý text thông thường mình làm được (mình đã làm bằng cách xem cấu trúc JSON rồi bắt chước theo). Vấn đề ở đây là mình muốn biết JavaScript có làm điều ngược lại được không
Mình đang hy vọng: nếu dùng công cụ chuyên nghiệp thì tốc độ xử lý phải nhanh hơn
???

AutoReply · 17/6/18

Chắc họ chừa mình ra. Ngồi xem thui. hi hi $-\\/.$

ndu96081631 · 17/6/18

AutoReply đã viết:
Chắc họ chừa mình ra. Ngồi xem thui. hi hi $-\\/.$

Vụ gì vậy bạn?

Import chuỗi JSON vào Excel

File đính kèm

ndu96081631

batman1

AutoReply

batman1

File đính kèm

kuldokk

AutoReply

batman1

ndu96081631

VetMini

AutoReply

VetMini

kuldokk

batman1

File đính kèm

AutoReply

AutoReply

File đính kèm

ndu96081631

batman1

AutoReply

ndu96081631

AutoReply

ndu96081631

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian