JSON conversion and parsing for VBA (Windows and Mac Excel, Access, and other Office applications). It grew out of the excellent project [vba-json](
https://code.google.com/p/vba-json/),
Tested in Windows Excel 2013 and Excel for Mac 2011, but should apply to 2007+.
''---------------------------------------------------------------------- '
' VBA-JSON v2.2.3
' (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.
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
OptionExplicit
' === VBA-UTC Headers
#If Mac Then
#If VBA7 Then
' 64-bit Mac (2016)
PrivateDeclare PtrSafe Function utc_popen Lib "libc.dylib" Alias "popen" _
(ByVal utc_Command AsString, ByVal utc_Mode AsString) As LongPtr
PrivateDeclare PtrSafe Function utc_pclose Lib "libc.dylib" Alias "pclose" _
(ByVal utc_File AsLong) As LongPtr
PrivateDeclare PtrSafe Function utc_fread Lib "libc.dylib" Alias "fread" _
(ByVal utc_Buffer AsString, ByVal utc_Size As LongPtr, ByVal utc_Number As LongPtr, ByVal utc_File As LongPtr) As LongPtr
PrivateDeclare PtrSafe Function utc_feof Lib "libc.dylib" Alias "feof" _
(ByVal utc_File As LongPtr) As LongPtr
#Else
' 32-bit Mac
PrivateDeclareFunction utc_popen Lib "libc.dylib" Alias "popen" _
(ByVal utc_Command AsString, ByVal utc_Mode AsString) AsLong
PrivateDeclareFunction utc_pclose Lib "libc.dylib" Alias "pclose" _
(ByVal utc_File AsLong) AsLong
PrivateDeclareFunction utc_fread Lib "libc.dylib" Alias "fread" _
(ByVal utc_Buffer AsString, ByVal utc_Size AsLong, ByVal utc_Number AsLong, ByVal utc_File AsLong) AsLong
PrivateDeclareFunction utc_feof Lib "libc.dylib" Alias "feof" _
(ByVal utc_File AsLong) AsLong
#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
PrivateDeclare PtrSafe Function utc_GetTimeZoneInformation Lib "kernel32" Alias "GetTimeZoneInformation" _
(utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION) AsLong
PrivateDeclare 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) AsLong
PrivateDeclare 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) AsLong
#Else
PrivateDeclareFunction utc_GetTimeZoneInformation Lib "kernel32" Alias "GetTimeZoneInformation" _
(utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION) AsLong
PrivateDeclareFunction utc_SystemTimeToTzSpecificLocalTime Lib "kernel32" Alias "SystemTimeToTzSpecificLocalTime" _
(utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpUniversalTime As utc_SYSTEMTIME, utc_lpLocalTime As utc_SYSTEMTIME) AsLong
PrivateDeclareFunction utc_TzSpecificLocalTimeToSystemTime Lib "kernel32" Alias "TzSpecificLocalTimeToSystemTime" _
(utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpLocalTime As utc_SYSTEMTIME, utc_lpUniversalTime As utc_SYSTEMTIME) AsLong
#End If
#If Mac Then
#If VBA7 Then
PrivateType utc_ShellResult
utc_Output AsString
utc_ExitCode As LongPtr
EndType
#Else
PrivateType utc_ShellResult
utc_Output AsString
utc_ExitCode AsLong
EndType
#End If
#Else
PrivateType utc_SYSTEMTIME
utc_wYear AsInteger
utc_wMonth AsInteger
utc_wDayOfWeek AsInteger
utc_wDay AsInteger
utc_wHour AsInteger
utc_wMinute AsInteger
utc_wSecond AsInteger
utc_wMilliseconds AsInteger
EndType
PrivateType utc_TIME_ZONE_INFORMATION
utc_Bias AsLong
utc_StandardName(0 To 31) AsInteger
utc_StandardDate As utc_SYSTEMTIME
utc_StandardBias AsLong
utc_DaylightName(0 To 31) AsInteger
utc_DaylightDate As utc_SYSTEMTIME
utc_DaylightBias AsLong
EndType
#End If
' === End VBA-UTC
#If Mac Then
#ElseIf VBA7 Then
PrivateDeclare PtrSafe Sub json_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(json_MemoryDestination As Any, json_MemorySource As Any, ByVal json_ByteLength AsLong)
#Else
PrivateDeclareSub json_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(json_MemoryDestination As Any, json_MemorySource As Any, ByVal json_ByteLength AsLong)
#End If
PrivateType 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 AsBoolean
' The JSON standard requires object keys to be quoted (" or '), use this option to allow unquoted keys
AllowUnquotedKeys AsBoolean
' The solidus (/) is not required to be escaped, use this option to escape them as \/ in ConvertToJson
EscapeSolidus AsBoolean
EndType
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
''
PublicFunction ParseJson(ByVal JsonString AsString) AsObject
Dim json_Index AsLong
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
SelectCase VBA.Mid$(JsonString, json_Index, 1)
Case"{"
Set ParseJson = json_ParseObject(JsonString, json_Index)
Case"["
Set ParseJson = json_ParseArray(JsonString, json_Index)
CaseElse
' Error: Invalid JSON string
Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(JsonString, json_Index, "Expecting '{' or '['")
EndSelect
EndFunction
''
' 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}
''
PublicFunction ConvertToJson(ByVal JsonValue AsVariant, OptionalByVal Whitespace AsVariant, OptionalByVal json_CurrentIndentation AsLong = 0) AsString
Dim json_buffer AsString
Dim json_BufferPosition AsLong
Dim json_BufferLength AsLong
Dim json_Index AsLong
Dim json_LBound AsLong
Dim json_UBound AsLong
Dim json_IsFirstItem AsBoolean
Dim json_Index2D AsLong
Dim json_LBound2D AsLong
Dim json_UBound2D AsLong
Dim json_IsFirstItem2D AsBoolean
Dim json_Key AsVariant
Dim json_Value AsVariant
Dim json_DateStr AsString
Dim json_Converted AsString
Dim json_SkipItem AsBoolean
Dim json_PrettyPrint AsBoolean
Dim json_Indentation AsString
Dim json_InnerIndentation AsString
json_LBound = -1
json_UBound = -1
json_IsFirstItem = True
json_LBound2D = -1
json_UBound2D = -1
json_IsFirstItem2D = True
json_PrettyPrint = Not IsMissing(Whitespace)
SelectCase 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)
IfNot JsonOptions.UseDoubleForLargeNumbers And json_StringIsLargeNumber(JsonValue) Then
ConvertToJson = JsonValue
Else
ConvertToJson = """"& json_Encode(JsonValue) & """"
EndIf
Case VBA.vbBoolean
If JsonValue Then
ConvertToJson = "true"
Else
ConvertToJson = "false"
EndIf
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)
EndIf
EndIf
' Array
json_BufferAppend json_buffer, "[", json_BufferPosition, json_BufferLength
OnErrorResumeNext
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
EndIf
If json_LBound2D >= 0 And json_UBound2D >= 0 Then
' 2D Array
If json_PrettyPrint Then
json_BufferAppend json_buffer, vbNewLine, json_BufferPosition, json_BufferLength
EndIf
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
EndIf
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"
EndIf
EndIf
If json_PrettyPrint Then
json_Converted = vbNewLine & json_InnerIndentation & json_Converted
EndIf
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
EndIf
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"
EndIf
EndIf
If json_PrettyPrint Then
json_Converted = vbNewLine & json_Indentation & json_Converted
EndIf
json_BufferAppend json_buffer, json_Converted, json_BufferPosition, json_BufferLength
EndIf
Next json_Index
EndIf
OnErrorGoTo 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)
EndIf
EndIf
json_BufferAppend json_buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength
ConvertToJson = json_BufferToString(json_buffer, json_BufferPosition, json_BufferLength)
' 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)
EndIf
EndIf
' Dictionary
If VBA.TypeName(JsonValue) = "Dictionary"Then
json_BufferAppend json_buffer, "{", json_BufferPosition, json_BufferLength
ForEach 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
EndIf
IfNot json_SkipItem Then
If json_IsFirstItem Then
json_IsFirstItem = False
Else
json_BufferAppend json_buffer, ",", json_BufferPosition, json_BufferLength
EndIf
If json_PrettyPrint Then
json_Converted = vbNewLine & json_Indentation & """"& json_Key & """: "& json_Converted
Else
json_Converted = """"& json_Key & """:"& json_Converted
EndIf
json_BufferAppend json_buffer, json_Converted, json_BufferPosition, json_BufferLength
EndIf
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)
EndIf
EndIf
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
ForEach json_Value In JsonValue
If json_IsFirstItem Then
json_IsFirstItem = False
Else
json_BufferAppend json_buffer, ",", json_BufferPosition, json_BufferLength
EndIf
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"
EndIf
EndIf
If json_PrettyPrint Then
json_Converted = vbNewLine & json_Indentation & json_Converted
EndIf
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)
EndIf
EndIf
json_BufferAppend json_buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength
EndIf
ConvertToJson = json_BufferToString(json_buffer, json_BufferPosition, json_BufferLength)
Case VBA.vbInteger, VBA.vbLong, VBA.vbSingle, VBA.vbDouble, VBA.vbCurrency, VBA.vbDecimal
' Number (use decimals for numbers)
ConvertToJson = VBA.Replace(JsonValue, ",", ".")
CaseElse
' vbEmpty, vbError, vbDataObject, vbByte, vbUserDefinedType
' Use VBA's built-in to-string
OnErrorResumeNext
ConvertToJson = JsonValue
OnErrorGoTo 0
EndSelect
EndFunction
' ============================================= '
' Private Functions
' ============================================= '
PrivateFunction json_ParseObject(json_String AsString, ByRef json_Index AsLong) As Dictionary
Dim json_Key AsString
Dim json_NextChar AsString
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
ExitFunction
ElseIf VBA.Mid$(json_String, json_Index, 1) = ","Then
json_Index = json_Index + 1
json_SkipSpaces json_String, json_Index
EndIf
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)
EndIf
Loop
EndIf
EndFunction
PrivateFunction json_ParseArray(json_String AsString, ByRef json_Index AsLong) 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
ExitFunction
ElseIf VBA.Mid$(json_String, json_Index, 1) = ","Then
json_Index = json_Index + 1
json_SkipSpaces json_String, json_Index
EndIf
json_ParseArray.Add json_ParseValue(json_String, json_Index)
Loop
EndIf
EndFunction
PrivateFunction json_ParseValue(json_String AsString, ByRef json_Index AsLong) AsVariant
json_SkipSpaces json_String, json_Index
SelectCase 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)
CaseElse
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 '['")
EndIf
EndSelect
EndFunction
PrivateFunction json_ParseString(json_String AsString, ByRef json_Index AsLong) AsString
Dim json_Quote AsString
Dim json_Char AsString
Dim json_Code AsString
Dim json_buffer AsString
Dim json_BufferPosition AsLong
Dim json_BufferLength AsLong
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
DoWhile json_Index > 0 And json_Index <= Len(json_String)
json_Char = VBA.Mid$(json_String, json_Index, 1)
SelectCase json_Char
Case"\"
' Escaped string, \\, or \/
json_Index = json_Index + 1
json_Char = VBA.Mid$(json_String, json_Index, 1)
SelectCase 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
EndSelect
Case json_Quote
json_ParseString = json_BufferToString(json_buffer, json_BufferPosition, json_BufferLength)
json_Index = json_Index + 1
ExitFunction
CaseElse
json_BufferAppend json_buffer, json_Char, json_BufferPosition, json_BufferLength
json_Index = json_Index + 1
EndSelect
Loop
EndFunction
PrivateFunction json_ParseNumber(json_String AsString, ByRef json_Index AsLong) AsVariant
Dim json_Char AsString
Dim json_Value AsString
Dim json_IsLargeNumber AsBoolean
json_SkipSpaces json_String, json_Index
DoWhile 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)
IfNot 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)
EndIf
ExitFunction
EndIf
Loop
EndFunction
PrivateFunction json_ParseKey(json_String AsString, ByRef json_Index AsLong) AsString
' 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 AsString
DoWhile 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
ExitDo
EndIf
Loop
Else
Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting '""' or '''")
EndIf
' 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
EndIf
EndFunction
PrivateFunction json_IsUndefined(ByVal json_Value AsVariant) AsBoolean
' Empty / Nothing -> undefined
SelectCase VBA.VarType(json_Value)
Case VBA.vbEmpty
json_IsUndefined = True
Case VBA.vbObject
SelectCase VBA.TypeName(json_Value)
Case"Empty", "Nothing"
json_IsUndefined = True
EndSelect
EndSelect
EndFunction
PrivateFunction json_Encode(ByVal json_Text AsVariant) AsString
' Reference: http://www.ietf.org/rfc/rfc4627.txt
' Escape: ", \, /, backspace, form feed, line feed, carriage return, tab
Dim json_Index AsLong
Dim json_Char AsString
Dim json_AscCode AsLong
Dim json_buffer AsString
Dim json_BufferPosition AsLong
Dim json_BufferLength AsLong
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
EndIf
' From spec, ", \, and control characters must be escaped (solidus is optional)
SelectCase json_AscCode
Case 34
'" -> 34 -> \"
json_Char = "\"""
Case 92
' \ -> 92 -> \\
json_Char = "\\"
Case 47
' / -> 47 -> \/ (optional)
If JsonOptions.EscapeSolidus Then
json_Char = "\/"
EndIf
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)
EndSelect
json_BufferAppend json_buffer, json_Char, json_BufferPosition, json_BufferLength
Next json_Index
json_Encode = json_BufferToString(json_buffer, json_BufferPosition, json_BufferLength)
EndFunction
PrivateFunction json_Peek(json_String AsString, ByVal json_Index AsLong, Optional json_NumberOfCharacters AsLong = 1) AsString
'"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)
EndFunction
PrivateSub json_SkipSpaces(json_String AsString, ByRef json_Index AsLong)
' Increment index to skip over spaces
DoWhile json_Index > 0 And json_Index <= VBA.Len(json_String) And VBA.Mid$(json_String, json_Index, 1) = ""
json_Index = json_Index + 1
Loop
EndSub
PrivateFunction json_StringIsLargeNumber(json_String AsVariant) AsBoolean
' Check if the given string is considered a "large number"
' (See json_ParseNumber)
Dim json_Length AsLong
Dim json_CharIndex AsLong
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 AsString
Dim json_Index AsLong
json_StringIsLargeNumber = True
For json_CharIndex = 1 To json_Length
json_CharCode = VBA.Asc(VBA.Mid$(json_String, json_CharIndex, 1))
SelectCase json_CharCode
' Look for .|0-9|E|e
Case 46, 48 To 57, 69, 101
' Continue through characters
CaseElse
json_StringIsLargeNumber = False
ExitFunction
EndSelect
Next json_CharIndex
EndIf
EndFunction
PrivateFunction json_ParseErrorMessage(json_String AsString, ByRef json_Index AsLong, ErrorMessage AsString)
' 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 AsLong
Dim json_StopIndex AsLong
' 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
EndIf
If json_StopIndex > VBA.Len(json_String) Then
json_StopIndex = VBA.Len(json_String)
EndIf
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
EndFunction
PrivateSub json_BufferAppend(ByRef json_buffer AsString, _
ByRef json_Append AsVariant, _
ByRef json_BufferPosition AsLong, _
ByRef json_BufferLength AsLong)
#If Mac Then
json_buffer = json_buffer & json_Append
#Else
' 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
'
' Copy memory for "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
Dim json_AppendLength AsLong
Dim json_LengthPlusPosition AsLong
json_AppendLength = VBA.LenB(json_Append)
json_LengthPlusPosition = json_AppendLength + json_BufferPosition
If json_LengthPlusPosition > json_BufferLength Then
' Appending would overflow buffer, add chunks until buffer is long enough
Dim json_TemporaryLength AsLong
json_TemporaryLength = json_BufferLength
DoWhile json_TemporaryLength < json_LengthPlusPosition
' Initially, initialize string with 255 characters,
' then add large chunks (8192) after that
'
' Size: # Characters x 2 bytes / character
If json_TemporaryLength = 0 Then
json_TemporaryLength = json_TemporaryLength + 510
Else
json_TemporaryLength = json_TemporaryLength + 16384
EndIf
Loop
json_buffer = json_buffer & VBA.Space$((json_TemporaryLength - json_BufferLength) \ 2)
json_BufferLength = json_TemporaryLength
EndIf
' Copy memory from append to buffer at buffer position
json_CopyMemory ByVal json_UnsignedAdd(StrPtr(json_buffer), _
json_BufferPosition), _
ByVal StrPtr(json_Append), _
json_AppendLength
json_BufferPosition = json_BufferPosition + json_AppendLength
#End If
EndSub
PrivateFunction json_BufferToString(ByRef json_buffer AsString, ByVal json_BufferPosition AsLong, ByVal json_BufferLength AsLong) AsString
#If Mac Then
json_BufferToString = json_buffer
#Else
If json_BufferPosition > 0 Then
json_BufferToString = VBA.Left$(json_buffer, json_BufferPosition \ 2)
EndIf
#End If
EndFunction
#If VBA7 Then
PrivateFunction json_UnsignedAdd(json_Start As LongPtr, json_Increment AsLong) As LongPtr
#Else
PrivateFunction json_UnsignedAdd(json_Start AsLong, json_Increment AsLong) AsLong
#End If
If json_Start And&H80000000 Then
json_UnsignedAdd = json_Start + json_Increment
ElseIf (json_Start Or&H80000000) < -json_Increment Then
json_UnsignedAdd = json_Start + json_Increment
Else
json_UnsignedAdd = (json_Start + &H80000000) + (json_Increment + &H80000000)
EndIf
EndFunction
''
' VBA-UTC v1.0.3
' (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
''
PublicFunction ParseUtc(utc_UtcDate AsDate) AsDate
OnErrorGoTo 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
ExitFunction
utc_ErrorHandling:
Err.Raise 10011, "UtcConverter.ParseUtc", "UTC parsing error: "& Err.Number & " - "& Err.Description
EndFunction
''
' Convert local date to UTC date
'
' @method ConvertToUrc
' @param {Date} utc_LocalDate
' @return {Date} UTC date
' @throws 10012 - UTC conversion error
''
PublicFunction ConvertToUtc(utc_LocalDate AsDate) AsDate
OnErrorGoTo 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
ExitFunction
utc_ErrorHandling:
Err.Raise 10012, "UtcConverter.ConvertToUtc", "UTC conversion error: "& Err.Number & " - "& Err.Description
EndFunction
''
' Parse ISO 8601 date string to local date
'
' @method ParseIso
' @param {Date} utc_IsoString
' @return {Date} Local date
' @throws 10013 - ISO 8601 parsing error
''
PublicFunction ParseIso(utc_IsoString AsString) AsDate
OnErrorGoTo utc_ErrorHandling
Dim utc_Parts() AsString
Dim utc_DateParts() AsString
Dim utc_TimeParts() AsString
Dim utc_OffsetIndex AsLong
Dim utc_HasOffset AsBoolean
Dim utc_NegativeOffset AsBoolean
Dim utc_OffsetParts() AsString
Dim utc_Offset AsDate
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)))
IfUBound(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), "-")
EndIf
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), ":")
SelectCaseUBound(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))))
EndSelect
If utc_NegativeOffset Then: utc_Offset = -utc_Offset
Else
utc_TimeParts = VBA.Split(utc_Parts(1), ":")
EndIf
EndIf
SelectCaseUBound(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))))
EndSelect
ParseIso = ParseUtc(ParseIso)
If utc_HasOffset Then
ParseIso = ParseIso + utc_Offset
EndIf
EndIf
ExitFunction
utc_ErrorHandling:
Err.Raise 10013, "UtcConverter.ParseIso", "ISO 8601 parsing error for "& utc_IsoString & ": "& Err.Number & " - "& Err.Description
EndFunction
''
' Convert local date to ISO 8601 string
'
' @method ConvertToIso
' @param {Date} utc_LocalDate
' @return {Date} ISO 8601 string
' @throws 10014 - ISO 8601 conversion error
''
PublicFunction ConvertToIso(utc_LocalDate AsDate) AsString
OnErrorGoTo utc_ErrorHandling
ConvertToIso = VBA.Format$(ConvertToUtc(utc_LocalDate), "yyyy-mm-ddTHH:mm:ss.000Z")
ExitFunction
utc_ErrorHandling:
Err.Raise 10014, "UtcConverter.ConvertToIso", "ISO 8601 conversion error: "& Err.Number & " - "& Err.Description
EndFunction
' ============================================= '
' Private Functions
' ============================================= '
#If Mac Then
PrivateFunction utc_ConvertDate(utc_Value AsDate, Optional utc_ConvertToUtc AsBoolean = False) AsDate
Dim utc_ShellCommand AsString
Dim utc_Result As utc_ShellResult
Dim utc_Parts() AsString
Dim utc_DateParts() AsString
Dim utc_TimeParts() AsString
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'"
EndIf
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))
EndIf
EndFunction
PrivateFunction utc_ExecuteInShell(utc_ShellCommand AsString) As utc_ShellResult
#If VBA7 Then
Dim utc_File As LongPtr
Dim utc_Read As LongPtr
#Else
Dim utc_File AsLong
Dim utc_Read AsLong
#End If
Dim utc_Chunk AsString
OnErrorGoTo utc_ErrorHandling
utc_File = utc_popen(utc_ShellCommand, "r")
If utc_File = 0 Then: ExitFunction
DoWhile utc_feof(utc_File) = 0
utc_Chunk = VBA.Space$(50)
utc_Read = utc_fread(utc_Chunk, 1, Len(utc_Chunk) - 1, utc_File)
If utc_Read > 0 Then
utc_Chunk = VBA.Left$(utc_Chunk, utc_Read)
utc_ExecuteInShell.utc_Output = utc_ExecuteInShell.utc_Output & utc_Chunk
EndIf
Loop
utc_ErrorHandling:
utc_ExecuteInShell.utc_ExitCode = utc_pclose(utc_File)
EndFunction
#Else
PrivateFunction utc_DateToSystemTime(utc_Value AsDate) 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
EndFunction
PrivateFunction utc_SystemTimeToDate(utc_Value As utc_SYSTEMTIME) AsDate
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)
EndFunction
#End If
- For Windows-only support, include a reference to "Microsoft Scripting Runtime"
- For Mac and Windows support, include [VBA-Dictionary](https://github.com/VBA-tools/VBA-Dictionary)
# Examples
Dim Json AsObject
Set Json = JsonConverter.ParseJson("{""a"":123,""b"":[1,2,3,4],""c"":{""d"":456}}")
' Json("a") -> 123
' Json("b")(2) -> 2
' Json("c")("d") -> 456
Json("c")("e") = 789
Debug.Print JsonConverter.ConvertToJson(Json)
' -> "{"a":123,"b":[1,2,3,4],"c":{"d":456,"e":789}}"
Debug.Print JsonConverter.ConvertToJson(Json, Whitespace:=2)
' -> "{
'"a": 123,
'"b": [
' 1,
' 2,
' 3,
' 4
' ],
'"c": {
'"d": 456,
'"e": 789
' }
' }"
```
```vb
' Advanced example: Read .json file and load into sheet (Windows-only)
' (add reference to Microsoft Scripting Runtime)
' {"values":[{"a":1,"b":2,"c": 3},...]}
Dim FSO AsNew FileSystemObject
Dim JsonTS As TextStream
Dim JsonText AsString
Dim Parsed As Dictionary
' Read .json file
Set JsonTS = FSO.OpenTextFile("example.json", ForReading)
JsonText = JsonTS.ReadAll
JsonTS.Close
' Parse json to Dictionary
'"values" is parsed as Collection
' each item in "values" is parsed as Dictionary
Set Parsed = JsonConverter.ParseJson(JsonText)
' Prepare and write values to sheet
Dim Values AsVariant
ReDim Values(Parsed("values").Count, 3)
Dim Value As Dictionary
Dim i AsLong
i = 0
ForEach Value In Parsed("values")
Values(i, 0) = Value("a")
Values(i, 1) = Value("b")
Values(i, 2) = Value("c")
i = i + 1
Next Value
Sheets("example").Range(Cells(1, 1), Cells(Parsed("values").Count, 3)) = Values
## Options
VBA-JSON includes a few options for customizing parsing/conversion if needed:
- __UseDoubleForLargeNumbers__ (Default = `False`) 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.
By default, VBA-JSON will use `String` for numbers longer than 15 characters that contain only digits, use this option to use `Double` instead.
- __AllowUnquotedKeys__ (Default = `False`) The JSON standard requires object keys to be quoted (`"` or `'`), use this option to allow unquoted keys.
- __EscapeSolidus__ (Default = `False`) The solidus (`/`) is not required to be escaped, use this option to escape them as `\/` in `ConvertToJson`.
```VB.net
JsonConverter.JsonOptions.EscapeSolidus = True
```
## Installation
2. Import `JsonConverter.bas` into your project (Open VBA Editor, `Alt + F11`; File > Import File)
3. Add `Dictionary` reference/class
- For Windows-only, include a reference to "Microsoft Scripting Runtime"
## Resources
- [Tutorial Video (Red Stapler)](https://youtu.be/CFFLRmHsEAs)
