Almost finished
Diff
#*superscratch*# | 1 -
#Makefile# | 0
*scratch* | 308 --------------------------------------------------------------------------------
Writeup.docm | 0
Writeup.pdf | 0
cv.docm.bak | 0
cv.docm.bak.2.docm | 0
cv.dotx | 0
cvr1.docm | 0
src.bak/NewMacros.bas | 66 ------------------------------------------------------------------
src.bak/StringTable.bas | 11 -----------
src.bak/YAML.cls | 330 --------------------------------------------------------------------------------
src/#NewMacros.bas# | 10 ----------
src/CV.bas | 6 +++---
src/JsonConverter.bas | 1123 --------------------------------------------------------------------------------
src/Project.ini | 8 ++++----
src/ThisDocument.cls | 13 -------------
src.bak/Class Modules/YAML.cls | 353 --------------------------------------------------------------------------------
src.bak/Modules/NewMacros.bas | 58 ----------------------------------------------------------
src.bak/Modules/YAMLParser_old.bas | 313 --------------------------------------------------------------------------------
20 files changed, 7 insertions(+), 2593 deletions(-)
@@ -1,1 +1,0 @@
cvProps("projects")(ID_SELF)(l)("title")(ID_SELF)
@@ -1,308 +1,0 @@
{
"___type___": "Dictionary",
"name": {
"___type___": "String",
"___self___": "Jacob Walchuk"
},
"email": {
"___type___": "String",
"___self___": "walchuk2018@icloud.com"
},
"www": {
"___type___": "String",
"___self___": "jacob.hcol.uk\n"
},
"phones": {
"___type___": "Array",
"___self___": [
{
"___type___": "Dictionary",
"cc": {
"___type___": "String",
"___self___": "UK"
},
"phone": {
"___type___": "String",
"___self___": "+44 7519 615 066"
}
},
{
"___type___": "Dictionary",
"cc": {
"___type___": "String",
"___self___": "CA"
},
"phone": {
"___type___": "String",
"___self___": "+1 604 880 4825\n"
}
}
]
},
"cv": {
"___type___": "Array",
"___self___": [
{
"___type___": "Dictionary",
"title": {
"___type___": "String",
"___self___": "Education"
},
"entries": {
"___type___": "Array",
"___self___": [
{
"___type___": "Dictionary",
"title": {
"___type___": "String",
"___self___": "Westside School"
},
"location": {
"___type___": "String",
"___self___": "Vancouver, Canada"
},
"date": {
"___type___": "String",
"___self___": "2019---2021"
},
"bullets": {
"___type___": "Array",
"___self___": [
{
"___type___": "String",
"___self___": "A*A*A*A*A-equivalent marks, per KCL's conversion scale."
}
]
}
},
{
"___type___": "Dictionary",
"title": {
"___type___": "String",
"___self___": "Trinity Western University"
},
"role": {
"___type___": "String",
"___self___": "B.A. in Political Studies"
},
"location": {
"___type___": "String",
"___self___": "Langley, Canada"
},
"date": {
"___type___": "String",
"___self___": "2021---2022"
},
"bullets": {
"___type___": "Array",
"___self___": [
{
"___type___": "String",
"___self___": "Received a 4.23/4.3 grade average in my first year, before transferring."
}
]
}
},
{
"___type___": "Dictionary",
"title": {
"___type___": "String",
"___self___": "University of St. Andrews"
},
"role": {
"___type___": "String",
"___self___": "M.A. Hons. in Philosophy"
},
"location": {
"___type___": "String",
"___self___": "St. Andrews, Scotland"
},
"date": {
"___type___": "String",
"___self___": "2022---2025"
},
"bullets": {
"___type___": "Array",
"___self___": [
{
"___type___": "String",
"___self___": "Standing 2:2 Honours, with a focus on symbolic logic and analytic metaphysics."
}
]
}
}
]
}
},
{
"___type___": "Dictionary",
"title": {
"___type___": "String",
"___self___": "Work Experience"
},
"entries": {
"___type___": "Array",
"___self___": [
{
"___type___": "Dictionary",
"title": {
"___type___": "String",
"___self___": "Kova Engineering, Ltd."
},
"role": {
"___type___": "String",
"___self___": "Technical Analyst Intern"
},
"location": {
"___type___": "String",
"___self___": "Langley, Canada"
},
"date": {
"___type___": "String",
"___self___": "Summer 2023"
},
"bullets": {
"___type___": "Array",
"___self___": [
{
"___type___": "String",
"___self___": "Discovered employee concerns around an improperly-scaled MySQL database with a ColdFusion frontend, and wrote a longform report on the costs and benefits of a full-stack overhaul to PostgreSQL and Next.js."
},
{
"___type___": "String",
"___self___": "Consulted with the CEO, CTO, and other members of the executive team in discovering their needs."
},
{
"___type___": "String",
"___self___": "Submitted a code proposal to the lead programmer, which secured and sped up interoperability between the old and new system."
}
]
}
},
{
"___type___": "Dictionary",
"title": {
"___type___": "String",
"___self___": "Kova Engineering, Ltd."
},
"role": {
"___type___": "String",
"___self___": "Assistant I.T. Technician"
},
"location": {
"___type___": "String",
"___self___": "Langley, Canada"
},
"date": {
"___type___": "String",
"___self___": "2018---2022"
},
"bullets": {
"___type___": "Array",
"___self___": [
{
"___type___": "String",
"___self___": "Deployed laptops and servers running Windows, and iPhones using Apple's Device Enrolment Programme."
},
{
"___type___": "String",
"___self___": "Onboarded metallurgy technicians with little-to-no IT background."
}
]
}
},
{
"___type___": "Dictionary",
"title": {
"___type___": "String",
"___self___": "Free Geek Vancouver"
},
"role": {
"___type___": "String",
"___self___": "Repair Technician"
},
"date": {
"___type___": "String",
"___self___": "2017---2018"
},
"location": {
"___type___": "String",
"___self___": "Vancouver, Canada"
},
"bullets": {
"___type___": "Array",
"___self___": [
{
"___type___": "String",
"___self___": "Stress-tested PC components including RAM, CPUs, and GPUs, and performed light component-level board repair.\n"
}
]
}
}
]
}
}
]
},
"projects": {
"___type___": "Array",
"___self___": [
{
"___type___": "Dictionary",
"title": {
"___type___": "String",
"___self___": "Book Tracker"
},
"description": {
"___type___": "String",
"___self___": "Reverse-engineered the SQLite schemas of bibliographic and note-taking software, and wrote a quick Node.js tool to generate progress reports and publish notes to my personal website."
}
},
{
"___type___": "Dictionary",
"title": {
"___type___": "String",
"___self___": "Homelab"
},
"description": {
"___type___": "String",
"___self___": "Ran a decommissioned rackmount server at home, deploying KVM on Debian, and later, Xen."
}
}
]
},
"skills": {
"___type___": "Array",
"___self___": [
{
"___type___": "String",
"___self___": "Certifications: CompTIA Linux+, IBM Data Analyst Certificate (Excel, Cognos, and R), IBM Data Science Certificate (Python)."
},
{
"___type___": "String",
"___self___": "Languages: Mandarin (working proficiency), German (basic)."
},
{
"___type___": "String",
"___self___": "Proficient in VBA, HTML/CSS/JS, and Emacs LISP."
},
{
"___type___": "String",
"___self___": "Interests: Linguistics, social and economic history, corporate finance.\n"
}
]
},
"footer": {
"___type___": "Array",
"___self___": [
{
"___type___": "String",
"___self___": "Authorised to work full-time in the UK, without sponsorship."
},
{
"___type___": "String",
"___self___": "This {{DOCTYPE}} was generated from YAML source using {{LANG}}. For more information, see jacob.hcol.uk/cv.\n"
}
]
}
}
Binary files a/Writeup.docm and /dev/null differ
Binary files a/Writeup.pdf and /dev/null differ
Binary files a/cv.docm.bak and /dev/null differ
Binary files a/cv.docm.bak.2.docm and /dev/null differ
Binary files a/cv.dotx and /dev/null differ
Binary files a/cvr1.docm and /dev/null differ
@@ -1,66 +1,0 @@
Attribute VB_Name = "NewMacros"
Option Explicit
Sub Macro1()
Attribute Macro1.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Macro1"
'
' Macro1 Macro
'
'
Dim cvYAML As Object: Set cvYAML = New YAML
cvYAML.path = "\\Mac\iCloud\Development\cv\cv.yml"
Dim cvProps As Object: Set cvProps = cvYAML.props
Debug.Print cvProps("name")(ID_SELF)
'Dim cvProps As Dictionary:
'Debug.Print cvProps("name")(ID_SELF)
'Selection.Style = ActiveDocument.Styles("Title")
'Selection.TypeText Text:="This is a title"
'Selection.TypeParagraph
'Selection.TypeParagraph
'Selection.Style = ActiveDocument.Styles("Heading 1")
'Selection.TypeText Text:="Heading 1"
'Selection.TypeParagraph
'Selection.Style = ActiveDocument.Styles("No Spacing")
'Selection.TypeText Text:="Whatababab"
'Selection.TypeParagraph
'With ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1)
' .NumberFormat = ChrW(61623)
' .TrailingCharacter = wdTrailingTab
' .NumberStyle = wdListNumberStyleBullet
' .NumberPosition = InchesToPoints(0.25)
' .Alignment = wdListLevelAlignLeft
' .TextPosition = InchesToPoints(0.5)
' .TabPosition = wdUndefined
' .ResetOnHigher = 0
' .StartAt = 1
' With .Font
' .Bold = wdUndefined
' .Italic = wdUndefined
' .StrikeThrough = wdUndefined
' .Subscript = wdUndefined
' .Superscript = wdUndefined
' .Shadow = wdUndefined
' .Outline = wdUndefined
' .Emboss = wdUndefined
' .Engrave = wdUndefined
' .AllCaps = wdUndefined
' .Hidden = wdUndefined
' .Underline = wdUndefined
' .Color = wdUndefined
' .Size = wdUndefined
' .Animation = wdUndefined
' .DoubleStrikeThrough = wdUndefined
' .Name = "Symbol"
' End With
' .LinkedStyle = ""
'End With
'ListGalleries(wdBulletGallery).ListTemplates(1).Name = ""
'Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
' ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _
' False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
' wdWord10ListBehavior
'Selection.TypeText Text:="This is a bulletted list created manually"
'Selection.EscapeKey
End Sub
@@ -1,11 +1,0 @@
Attribute VB_Name = "StringTable"
Option Explicit
Public Const ID_SELF As String = "___self___"
Public Const ID_TYPE As String = "___type___"
Public Const MESSAGE_ERROR_GENERIC As String = "YAML Error"
Public Const MESSAGE_MALFORMED_TYPE As String = "Malformed YAML code on line "
Public Const MESSAGE_MALFORMED_YAML As String = "Malformed type error - this is a problem with the internal dictionary"
Public Const MESSAGE_GETPROP_NOT_STR As String = "Your module has tried to use getProp(), which is meant for type String, on a "
Public Const MESSAGE_GETPROP_NOT_FOUND As String = "Property not found."
@@ -1,330 +1,0 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "YAML"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' Const yamlPath As String = "\\Mac\iCloud\Development\cv\cv.yml"
Public yamlPath As String
Private Function RemoveEmptyStrings(arr() As String) As String()
Dim tempArray() As String
Dim i As Integer, j As Integer: j = 0
ReDim tempArray(LBound(arr) To UBound(arr))
j = 0
For i = LBound(arr) To UBound(arr)
If Len(arr(i)) > 0 Then
tempArray(j) = arr(i)
j = j + 1
End If
Next i
ReDim Preserve tempArray(0 To j - 1)
RemoveEmptyStrings = tempArray
End Function
Private Function RegexMatch(inputString As String, pattern As String, Optional isGlobal As Boolean = True) As Boolean
' checks for regex match without instantiating 80 gazillion objects
' parameters
' isGlobal: whether the regex check is global
Dim Regex As Object: Set Regex = CreateObject("VBScript.RegExp")
Regex.pattern = pattern
Regex.Global = isGlobal
RegexMatch = Regex.Test(inputString)
End Function
Private Function RegexSplit(inputString As String, pattern As String, Optional onlyFirst As Boolean = False, Optional splitBefore As Boolean = False) As String()
' splits array at any pattern that matches a regex
' parameters
' onlyFirst: if true, only splits the first instance of the match, creating an array of length 2
' splitBefore: if true, preserves the actual instance of the match
Dim Regex As Object: Set Regex = CreateObject("VBScript.RegExp")
Dim matches As Object
Dim match As Object
Dim splitParts() As String: ReDim splitParts(0 To 0)
Dim pos As Integer
Dim lastPos As Integer: lastPos = 1
Dim i As Integer: i = 0
' set regex flags
Regex.Global = True
Regex.IgnoreCase = False
Regex.pattern = pattern
Set matches = Regex.Execute(inputString)
' lastPos = 1
' i = 0
For Each match In matches
pos = match.FirstIndex + 1
ReDim Preserve splitParts(i)
splitParts(i) = Mid(inputString, lastPos, pos - lastPos)
If splitBefore Then
lastPos = pos
Else
lastPos = pos + Len(match.Value)
End If
i = i + 1
If onlyFirst Then Exit For
Next match
If lastPos <= Len(inputString) Then
ReDim Preserve splitParts(i)
splitParts(i) = Mid(inputString, lastPos)
End If
' retvrn
RegexSplit = RemoveEmptyStrings(splitParts)
End Function
Private Function RegexSubstitute(inputString As String, pattern As String, Optional substitution As String = "")
' does what it says on the tin
Dim Regex As Object: Set Regex = CreateObject("VBScript.RegExp")
Regex.pattern = pattern
Regex.IgnoreCase = False
Regex.Global = True
RegexSubstitute = Regex.Replace(inputString, substitution)
End Function
' YAML Layer Parser Pseudocode
' ====
' function GetYAMLLayerAsCollection(String fromYAML) {
' Collection mainDictionary = New Collection();
' if (fromYAML.containsRegex(/\n[A-Za-z]/)) {
' // is a dictionary
' String[] temporaryArray = fromYAML.split(/\n[A-Za-z]/);
' for each x in temporaryArray {
' x.splitByFirstInstanceOf(':\n');
' x[1].replaceAllInstancesOf('
' mainDictionary.add(x[0], x[1]);
' }
' } else if (fromYAML.containsRegex(/\n-/)) {
' // if array, process the array and return it as "self"
' String[] temporaryArray = fromYAML.splitBy('\n-');
' for each x in temporaryArray {
' x.removeAllInstancesOf('\n- ');
' x.replaceAllInstancesOf('\n ', '\n');
' mainDictionary.add("self", temporaryArray);
' }
' } else if (fromYAML.startsWith('"')) {
' mainDictionary.add("self", removeQuotes(fromYAML));
' } else {
' MsgBox("Processing error: neither array, dictionary, nor string");
' }
' }
Private Function GetYAMLLayerAsDictionary(fromYAML As String) As Dictionary
Dim mainDictionary As Dictionary: Set mainDictionary = New Dictionary
' create regex objects to test for dict, array, and string
'Dim regEx_dict As Object: Set regEx_dict = CreateObject("VBScript.RegExp")
'Dim regEx_arry As Object: Set regEx_arry = CreateObject("VBScript.RegExp")
'Dim regEx_strn As Object: Set regEx_strn = CreateObject("VBScript.RegExp")
'regEx_dict.Global = True: regEx_dict.Pattern = "\n[A-Za-z]"
'regEx_arry.Global = True: regEx_arry.Pattern = "\n-\s"
'regEx_strn.Global = False: regEx_strn.Pattern = "^\s*""(.*?)""\s*$"
Dim parts() As String
If RegexMatch(fromYAML, "(?:\n|\^)\w+:", True) Then
' is a dictionary
parts = RegexSplit(fromYAML, "\n\w+:", False, True)
Dim part As Variant ' not sure why it can't be as string but whatever billy gates
Call mainDictionary.Add(ID_TYPE, "Dictionary") ' identify as dict
For Each part In parts
Dim keyValue() As String: keyValue = RegexSplit(CStr(part), ":\s", True)
' trim trailing \n from category
If UBound(keyValue) > 0 Then
keyValue(0) = RegexSubstitute(keyValue(0), "^\n+")
' trim 2 spaces off of each line if they're there
keyValue(1) = RegexSubstitute(keyValue(1), "^\s{2}")
keyValue(1) = RegexSubstitute(keyValue(1), "\n\s{2}", vbLf)
Call mainDictionary.Add(keyValue(0), keyValue(1))
End If
Next part
ElseIf RegexMatch(fromYAML, "^-\s", True) Then
' is an array
Call mainDictionary.Add(ID_TYPE, "Array")
parts = RegexSplit(fromYAML, "(^|\n)-\s", False)
Dim i As Integer
For i = LBound(parts) To UBound(parts)
parts(i) = RegexSubstitute(parts(i), "\n\s{2}", vbLf)
Next i
Call mainDictionary.Add(ID_SELF, parts)
ElseIf RegexMatch(fromYAML, "^\s*""(.*?)""\s*$", True) Then
' is a string
Call mainDictionary.Add(ID_TYPE, "String")
Call mainDictionary.Add(ID_SELF, RegexSubstitute(fromYAML, """", ""))
Else
Call mainDictionary.Add(ID_SELF, "")
Debug.Print _
"Neither array, dictionary, nor string:" & _
vbCrLf & vbCrLf & fromYAML & vbCrLf & vbCrLf & _
"Make sure all strings are enclosed in double quotes." ', _
'vbOKOnly, "YAML Error")
End If
Set GetYAMLLayerAsDictionary = mainDictionary
End Function
' YAML Traverser Pseudocode
' ===
'
' function TraverseYAML(String fromYAML) {
' Dictionary mainDictionary = GetYAMLLayerAsDictionary(fromYAML);
' if mainDictionary.___type___ = "Dictionary" {
' for each entry in mainDictionary {
' TraverseYAML(entry)
' }
' return mainDictionary;
' } else if mainDictionary.___type___ = "Array" {
' for each entry in mainDictionary.___self___ {
' TraverseYAML(entry)
' }
' return mainDictionary;
' } else if mainDictionary.___type___ = "String" {
' return mainDictionary;
' } else {
' MsgBox("Internal YAML Error")
' }
' }
Private Function GetYAMLAsDictionary(fromYAML As String) As Dictionary
Dim mainDictionary As Object: Set mainDictionary = GetYAMLLayerAsDictionary(fromYAML)
Dim entry As Variant
If mainDictionary(ID_TYPE) = "Dictionary" Then
For Each entry In mainDictionary
Debug.Print "=== PROCESSING DICTIONARY ENTRY ==="
Debug.Print entry & " => " & mainDictionary(entry)
If entry <> ID_TYPE And entry <> ID_SELF Then
Set mainDictionary(entry) = GetYAMLAsDictionary(mainDictionary(entry))
End If
Next entry
ElseIf mainDictionary(ID_TYPE) = "Array" Then
Dim i As Integer
Dim subArray() As Object
For i = LBound(mainDictionary(ID_SELF)) To UBound(mainDictionary(ID_SELF))
Debug.Print "=== PROCESSING ARRAY ENTRY ==="
Debug.Print mainDictionary(ID_SELF)(i)
'Set subDictionary = GetYAMLAsDictionary(mainDictionary(ID_SELF)(i))
'Set mainDictionary(ID_SELF)(i) = subDictionary
ReDim Preserve subArray(i)
Set subArray(i) = GetYAMLAsDictionary(CStr(mainDictionary(ID_SELF)(i)))
Next i
mainDictionary(ID_SELF) = subArray
ElseIf mainDictionary(ID_TYPE) <> "String" Then
Debug.Print MESSAGE_MALFORMED_TYPE ', vbOKOnly, errIdentifier)
End If
Set GetYAMLAsDictionary = mainDictionary
End Function
' YAML Cleaner Pseudocode
' =====
' function YAMLCleaner(Dictionary mainDictionary) {
' for each entry in mainDictionary {
' if entry(ID_TYPE) == "Dictionary" {
' for each secondOrderEntry in entry {
' YAMLCleaner(secondOrderEntry)
' }
' } else if entry(ID_TYPE) == "Array" {
' for each secondOrderEntry in entry(ID_SELF) {
' YAMLCleaner(secondOrderEntry)
' }
' }
' if entry(ID_TYPE) != "Dictionary" {
' mainDictionary(entry) = mainDictionary(entry)(ID_SELF)
' }
' }
' return mainDictionary;
' }
'Function YAMLCleaner(mainDictionary As Dictionary) As Dictionary
' Dim entry As Variant
' If mainDictionary(ID_TYPE) = "Array" Then ' go through array and yamlclean it
' Dim i As Integer
' Debug.Print JsonConverter.ConvertToJson(mainDictionary)
' For i = LBound(mainDictionary(ID_SELF)) To UBound(mainDictionary(ID_SELF))
'
' 'If IsObject(mainDictionary(ID_SELF)(i)) Then
' 'Set mainDictionary(ID_SELF)(i) = YAMLCleaner(mainDictionary(ID_SELF)(i))
' 'Else
' ' Debug.Print "encountered non-object"
' 'End If
' Next i
' End If
' If mainDictionary(ID_TYPE) = "Dictionary" Then 'iterate through dict and yamlclena it
' For Each entry In mainDictionary
' If entry <> ID_TYPE Then
' Set mainDictionary(entry) = YAMLCleaner(mainDictionary(entry))
' End If
' Next entry
' End If
'
' For Each entry In mainDictionary
' If mainDictionary(ID_TYPE) = "Dictionary" And mainDictionary(entry)(ID_TYPE) <> "Dictionary" And entry <> ID_TYPE And entry <> ID_SELF Then
' Debug.Print "processing " & entry & " which is " & mainDictionary(entry)(ID_TYPE)
' If IsObject(mainDictionary(entry)(ID_SELF)) Then
' Set mainDictionary(entry) = mainDictionary(entry)(ID_SELF)
' Else
' mainDictionary(entry) = mainDictionary(entry)(ID_SELF)
' End If
' End If
' Next entry
'
' ' destroy type identifier?
' Set YAMLCleaner = mainDictionary
'End Function
Private Function GetFileAsString(filePath As String) As String
' Dim fileContent As String
Dim line As String
Dim fileNumber As Integer
'filePath = "\\Mac\iCloud\Development\cv\cv.yml"
fileNumber = FreeFile()
Open filePath For Input As fileNumber
Do While Not EOF(fileNumber)
Line Input #fileNumber, line
GetFileAsString = GetFileAsString & line & vbCrLf
Loop
End Function
Public Property Let path(thePath As String)
yamlPath = thePath
End Property
Public Property Get path() As String
path = yamlPath
End Property
Public Property Get props() As Dictionary
Set props = GetYAMLAsDictionary(GetFileAsString(yamlPath))
End Property
' YAML Indexer Pseudocode [implement later]
' =====
' function index(string theIndex) {
' Variant[] mainArray = theIndex.split(".");
' Dictionary mainDictionary = yamlProps;
' for each entry in mainArray {
' if entry is {
'
' ....
@@ -1,10 +1,0 @@
Attribute VB_Name = "NewMacros"
Option Explicit
Sub Macro1()
Attribute Macro1.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Macro1"
Dim cvYAML As Object: Set cvYAML = New YAML
cvYAML.path = "\\Mac\iCloud\Development\cv\cv.yml"
Dim cvProps As Object: Set cvProps = cvYAML.props
Debug.Print cvProps("name")(ID_SELF)
End Sub
@@ -100,12 +100,12 @@
.Bold = True
.SmallCaps = True
End With
Selection.TypeText Text:="bar" ' theTitles(i)
Selection.TypeText Text:=theTitles(i)
With Selection.Font
.Bold = False
.SmallCaps = False
End With
Selection.TypeText Text:=" - baz" ' " " & ChrW(8212) & " " & theDescriptions(i)
Selection.TypeText Text:=" " & ChrW(8212) & " " & theDescriptions(i)
Selection.TypeParagraph
Next i
@@ -188,7 +188,7 @@
For l = LBound(cvProps("projects")(ID_SELF)) To UBound(cvProps("projects")(ID_SELF))
' Debug.Print JsonConverter.ConvertToJson(cvProps("projects")(ID_SELF)(l), 2)
titles(l) = CStr(cvProps("projects")(ID_SELF)(l)("title")(ID_SELF))
descriptions(l) = CStr(cvProps("projects")(ID_SELF)(l)("title")(ID_SELF))
descriptions(l) = CStr(cvProps("projects")(ID_SELF)(l)("description")(ID_SELF))
Next l
DrawCompoundBulletedList titles, descriptions
@@ -1,1123 +1,0 @@
Attribute VB_Name = "JsonConverter"
''
' VBA-JSON v2.3.1
' (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 "/usr/lib/libc.dylib" Alias "popen" _
(ByVal utc_Command As String, ByVal utc_Mode As String) As LongPtr
Private Declare PtrSafe Function utc_pclose Lib "/usr/lib/libc.dylib" Alias "pclose" _
(ByVal utc_File As LongPtr) As LongPtr
Private Declare PtrSafe Function utc_fread Lib "/usr/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 "/usr/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.6
' (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
@@ -1,13 +1,13 @@
CodePage=1252
SysKind=3
Version=1761683227.9
ID="{0F3D9E32-5905-4E2D-8044-5C70D59D067F}"
ID="{A53BBDAC-3550-48F5-958E-E0945EBB4062}"
Name="Project"
HelpContextID="0"
VersionCompatible32="393222000"
CMG="7476B23FB646BA46BA46BA46BA"
DPB="7775B138B738BB39BB39BB"
GC="7A78BC3DBE3EBE3E41"
CMG="5052BC3AC03AC03AC03AC0"
DPB="BFBD53C6AD5A1D5B1D5B1D"
GC="2E2CC2775E89CC8ACC8A33"
[Host Extender Info]
&H00000001={3832D640-CF90-11CF-8E43-00A0C911005A};VBE;&H00000000
@@ -1,13 +1,0 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "1TemplateProject.ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True
Option Explicit
@@ -1,353 +1,0 @@
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "YAML"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' Const yamlPath As String = "\\Mac\iCloud\Development\cv\cv.yml"
' enums
Public yamlPath As String
Public yamlSerialised As Dictionary
Private Const ID_SELF As String = "___self___"
Private Const ID_TYPE As String = "___type___"
Private Const MESSAGE_ERROR_GENERIC As String = "YAML Error in " & yamlPath
Private Const MESSAGE_MALFORMED_TYPE As String = "Malformed YAML code at " & yamlPath & " on line "
Private Const MESSAGE_MALFORMED_YAML As String = "Malformed type error - this is a problem with the internal dictionary"
Private Const MESSAGE_GETPROP_NOT_STR As String = "Your module has tried to use getProp(), which is meant for type String, on a "
Private Const MESSAGE_GETPROP_NOT_FOUND As String = "Property not found."
Private Function RemoveEmptyStrings(arr() As String) As String()
Dim tempArray() As String
Dim i As Integer, j As Integer: j = 0
ReDim tempArray(LBound(arr) To UBound(arr))
j = 0
For i = LBound(arr) To UBound(arr)
If Len(arr(i)) > 0 Then
tempArray(j) = arr(i)
j = j + 1
End If
Next i
ReDim Preserve tempArray(0 To j - 1)
RemoveEmptyStrings = tempArray
End Function
Private Function RegexMatch(inputString As String, pattern As String, Optional isGlobal As Boolean = True) As Boolean
' checks for regex match without instantiating 80 gazillion objects
' parameters
' isGlobal: whether the regex check is global
Dim Regex As Object: Set Regex = CreateObject("VBScript.RegExp")
Regex.pattern = pattern
Regex.Global = isGlobal
RegexMatch = Regex.Test(inputString)
End Function
Private Function RegexSplit(inputString As String, pattern As String, Optional onlyFirst As Boolean = False, Optional splitBefore As Boolean = False) As String()
' splits array at any pattern that matches a regex
' parameters
' onlyFirst: if true, only splits the first instance of the match, creating an array of length 2
' splitBefore: if true, preserves the actual instance of the match
Dim Regex As Object: Set Regex = CreateObject("VBScript.RegExp")
Dim matches As Object
Dim match As Object
Dim splitParts() As String: ReDim splitParts(0 To 0)
Dim pos As Integer
Dim lastPos As Integer: lastPos = 1
Dim i As Integer: i = 0
' set regex flags
Regex.Global = True
Regex.IgnoreCase = False
Regex.pattern = pattern
Set matches = Regex.Execute(inputString)
' lastPos = 1
' i = 0
For Each match In matches
pos = match.FirstIndex + 1
ReDim Preserve splitParts(i)
splitParts(i) = Mid(inputString, lastPos, pos - lastPos)
If splitBefore Then
lastPos = pos
Else
lastPos = pos + Len(match.Value)
End If
i = i + 1
If onlyFirst Then Exit For
Next match
If lastPos <= Len(inputString) Then
ReDim Preserve splitParts(i)
splitParts(i) = Mid(inputString, lastPos)
End If
' retvrn
RegexSplit = RemoveEmptyStrings(splitParts)
End Function
Private Function RegexSubstitute(inputString As String, pattern As String, Optional substitution As String = "")
' does what it says on the tin
Dim Regex As Object: Set Regex = CreateObject("VBScript.RegExp")
Regex.pattern = pattern
Regex.IgnoreCase = False
Regex.Global = True
RegexSubstitute = Regex.Replace(inputString, substitution)
End Function
' YAML Layer Parser Pseudocode
' ====
' function GetYAMLLayerAsCollection(String fromYAML) {
' Collection mainDictionary = New Collection();
' if (fromYAML.containsRegex(/\n[A-Za-z]/)) {
' // is a dictionary
' String[] temporaryArray = fromYAML.split(/\n[A-Za-z]/);
' for each x in temporaryArray {
' x.splitByFirstInstanceOf(':\n');
' x[1].replaceAllInstancesOf('
' mainDictionary.add(x[0], x[1]);
' }
' } else if (fromYAML.containsRegex(/\n-/)) {
' // if array, process the array and return it as "self"
' String[] temporaryArray = fromYAML.splitBy('\n-');
' for each x in temporaryArray {
' x.removeAllInstancesOf('\n- ');
' x.replaceAllInstancesOf('\n ', '\n');
' mainDictionary.add("self", temporaryArray);
' }
' } else if (fromYAML.startsWith('"')) {
' mainDictionary.add("self", removeQuotes(fromYAML));
' } else {
' MsgBox("Processing error: neither array, dictionary, nor string");
' }
' }
Private Function GetYAMLLayerAsDictionary(fromYAML As String) As Dictionary
Dim mainDictionary As Dictionary: Set mainDictionary = New Dictionary
' create regex objects to test for dict, array, and string
'Dim regEx_dict As Object: Set regEx_dict = CreateObject("VBScript.RegExp")
'Dim regEx_arry As Object: Set regEx_arry = CreateObject("VBScript.RegExp")
'Dim regEx_strn As Object: Set regEx_strn = CreateObject("VBScript.RegExp")
'regEx_dict.Global = True: regEx_dict.Pattern = "\n[A-Za-z]"
'regEx_arry.Global = True: regEx_arry.Pattern = "\n-\s"
'regEx_strn.Global = False: regEx_strn.Pattern = "^\s*""(.*?)""\s*$"
Dim parts() As String
If RegexMatch(fromYAML, "(?:\n|\^)\w+:", True) Then
' is a dictionary
parts = RegexSplit(fromYAML, "\n\w+:", False, True)
Dim part As Variant ' not sure why it can't be as string but whatever billy gates
Call mainDictionary.Add(typeIdentifier, "Dictionary") ' identify as dict
For Each part In parts
Dim keyValue() As String: keyValue = RegexSplit(CStr(part), ":\s", True)
' trim trailing \n from category
If UBound(keyValue) > 0 Then
keyValue(0) = RegexSubstitute(keyValue(0), "^\n+")
' trim 2 spaces off of each line if they're there
keyValue(1) = RegexSubstitute(keyValue(1), "^\s{2}")
keyValue(1) = RegexSubstitute(keyValue(1), "\n\s{2}", vbLf)
Call mainDictionary.Add(keyValue(0), keyValue(1))
End If
Next part
ElseIf RegexMatch(fromYAML, "^-\s", True) Then
' is an array
Call mainDictionary.Add(typeIdentifier, "Array")
parts = RegexSplit(fromYAML, "(^|\n)-\s", False)
Dim i As Integer
For i = LBound(parts) To UBound(parts)
parts(i) = RegexSubstitute(parts(i), "\n\s{2}", vbLf)
Next i
Call mainDictionary.Add(selfIdentifier, parts)
ElseIf RegexMatch(fromYAML, "^\s*""(.*?)""\s*$", True) Then
' is a string
Call mainDictionary.Add(typeIdentifier, "String")
Call mainDictionary.Add(selfIdentifier, RegexSubstitute(fromYAML, """", ""))
Else
Call mainDictionary.Add(selfIdentifier, "")
Debug.Print _
"Neither array, dictionary, nor string:" & _
vbCrLf & vbCrLf & fromYAML & vbCrLf & vbCrLf & _
"Make sure all strings are enclosed in double quotes." ', _
'vbOKOnly, "YAML Error")
End If
Set GetYAMLLayerAsDictionary = mainDictionary
End Function
' YAML Traverser Pseudocode
' ===
'
' function TraverseYAML(String fromYAML) {
' Dictionary mainDictionary = GetYAMLLayerAsDictionary(fromYAML);
' if mainDictionary.___type___ = "Dictionary" {
' for each entry in mainDictionary {
' TraverseYAML(entry)
' }
' return mainDictionary;
' } else if mainDictionary.___type___ = "Array" {
' for each entry in mainDictionary.___self___ {
' TraverseYAML(entry)
' }
' return mainDictionary;
' } else if mainDictionary.___type___ = "String" {
' return mainDictionary;
' } else {
' MsgBox("Internal YAML Error")
' }
' }
Private Function GetYAMLAsDictionary(fromYAML As String) As Dictionary
Dim mainDictionary As Object: Set mainDictionary = GetYAMLLayerAsDictionary(fromYAML)
Dim entry As Variant
If mainDictionary(typeIdentifier) = "Dictionary" Then
For Each entry In mainDictionary
Debug.Print "=== PROCESSING DICTIONARY ENTRY ==="
Debug.Print entry & " => " & mainDictionary(entry)
If entry <> typeIdentifier And entry <> selfIdentifier Then
Set mainDictionary(entry) = GetYAMLAsDictionary(mainDictionary(entry))
End If
Next entry
ElseIf mainDictionary(typeIdentifier) = "Array" Then
Dim i As Integer
Dim subArray() As Object
For i = LBound(mainDictionary(selfIdentifier)) To UBound(mainDictionary(selfIdentifier))
Debug.Print "=== PROCESSING ARRAY ENTRY ==="
Debug.Print mainDictionary(selfIdentifier)(i)
'Set subDictionary = GetYAMLAsDictionary(mainDictionary(selfIdentifier)(i))
'Set mainDictionary(selfIdentifier)(i) = subDictionary
ReDim Preserve subArray(i)
Set subArray(i) = GetYAMLAsDictionary(CStr(mainDictionary(selfIdentifier)(i)))
Next i
mainDictionary(selfIdentifier) = subArray
ElseIf mainDictionary(typeIdentifier) <> "String" Then
Debug.Print malformedTypeError ', vbOKOnly, errIdentifier)
End If
Set GetYAMLAsDictionary = mainDictionary
End Function
' YAML Cleaner Pseudocode
' =====
' function YAMLCleaner(Dictionary mainDictionary) {
' for each entry in mainDictionary {
' if entry(typeIdentifier) == "Dictionary" {
' for each secondOrderEntry in entry {
' YAMLCleaner(secondOrderEntry)
' }
' } else if entry(typeIdentifier) == "Array" {
' for each secondOrderEntry in entry(selfIdentifier) {
' YAMLCleaner(secondOrderEntry)
' }
' }
' if entry(typeIdentifier) != "Dictionary" {
' mainDictionary(entry) = mainDictionary(entry)(selfIdentifier)
' }
' }
' return mainDictionary;
' }
'Function YAMLCleaner(mainDictionary As Dictionary) As Dictionary
' Dim entry As Variant
' If mainDictionary(typeIdentifier) = "Array" Then ' go through array and yamlclean it
' Dim i As Integer
' Debug.Print JsonConverter.ConvertToJson(mainDictionary)
' For i = LBound(mainDictionary(selfIdentifier)) To UBound(mainDictionary(selfIdentifier))
'
' 'If IsObject(mainDictionary(selfIdentifier)(i)) Then
' 'Set mainDictionary(selfIdentifier)(i) = YAMLCleaner(mainDictionary(selfIdentifier)(i))
' 'Else
' ' Debug.Print "encountered non-object"
' 'End If
' Next i
' End If
' If mainDictionary(typeIdentifier) = "Dictionary" Then 'iterate through dict and yamlclena it
' For Each entry In mainDictionary
' If entry <> typeIdentifier Then
' Set mainDictionary(entry) = YAMLCleaner(mainDictionary(entry))
' End If
' Next entry
' End If
'
' For Each entry In mainDictionary
' If mainDictionary(typeIdentifier) = "Dictionary" And mainDictionary(entry)(typeIdentifier) <> "Dictionary" And entry <> typeIdentifier And entry <> selfIdentifier Then
' Debug.Print "processing " & entry & " which is " & mainDictionary(entry)(typeIdentifier)
' If IsObject(mainDictionary(entry)(selfIdentifier)) Then
' Set mainDictionary(entry) = mainDictionary(entry)(selfIdentifier)
' Else
' mainDictionary(entry) = mainDictionary(entry)(selfIdentifier)
' End If
' End If
' Next entry
'
' ' destroy type identifier?
' Set YAMLCleaner = mainDictionary
'End Function
Private Function GetFileAsString(filePath As String) As String
' Dim fileContent As String
Dim line As String
Dim fileNumber As Integer
'filePath = "\\Mac\iCloud\Development\cv\cv.yml"
fileNumber = FreeFile()
Open filePath For Input As fileNumber
Do While Not EOF(fileNumber)
Line Input #fileNumber, line
GetFileAsString = GetFileAsString & line & vbCrLf
Loop
End Function
Public Property Let path(thePath As String)
yamlPath = thePath
End Property
Public Property Get path() As String
path = yamlPath
End Property
Public Property Get props() As Dictionary
Set props = GetYAMLAsDictionary(GetFileAsString(yamlPath))
End Property
' YAML Indexer Pseudocode [implement later]
' =====
' function index(string theIndex) {
' Variant[] mainArray = theIndex.split(".");
' Dictionary mainDictionary = yamlProps;
' for each entry in mainArray {
' if entry is {
'
' ....
'Public Sub TryFunction()
' Dim fileString As String: fileString = GetFileAsString("\\Mac\iCloud\Development\cv\cv.yml")
' Dim yamlLayer As Object
' Set yamlLayer = GetYAMLLayerAsDictionary(fileString)
' Dim yamlWholeDict As Object: Set yamlWholeDict = GetYAMLAsDictionary(fileString)
' 'Debug.Print JsonConverter.ConvertToJson(yamlWholeDict, 2, 2)
' Dim yamlCleanDict As Object: Set yamlCleanDict = YAMLCleaner(yamlWholeDict)
' Debug.Print JsonConverter.ConvertToJson(yamlCleanDict, 2, 2)
'End Sub
@@ -1,58 +1,0 @@
Attribute VB_Name = "NewMacros"
Option Explicit
Sub Macro1()
Attribute Macro1.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Macro1"
'
' Macro1 Macro
'
'
Selection.Style = ActiveDocument.Styles("Title")
Selection.TypeText Text:="This is a title"
Selection.TypeParagraph
Selection.TypeParagraph
Selection.Style = ActiveDocument.Styles("Heading 1")
Selection.TypeText Text:="Heading 1"
Selection.TypeParagraph
Selection.Style = ActiveDocument.Styles("No Spacing")
Selection.TypeText Text:="Whatababab"
Selection.TypeParagraph
With ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1)
.NumberFormat = ChrW(61623)
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleBullet
.NumberPosition = InchesToPoints(0.25)
.Alignment = wdListLevelAlignLeft
.TextPosition = InchesToPoints(0.5)
.TabPosition = wdUndefined
.ResetOnHigher = 0
.StartAt = 1
With .Font
.Bold = wdUndefined
.Italic = wdUndefined
.StrikeThrough = wdUndefined
.Subscript = wdUndefined
.Superscript = wdUndefined
.Shadow = wdUndefined
.Outline = wdUndefined
.Emboss = wdUndefined
.Engrave = wdUndefined
.AllCaps = wdUndefined
.Hidden = wdUndefined
.Underline = wdUndefined
.Color = wdUndefined
.Size = wdUndefined
.Animation = wdUndefined
.DoubleStrikeThrough = wdUndefined
.Name = "Symbol"
End With
.LinkedStyle = ""
End With
ListGalleries(wdBulletGallery).ListTemplates(1).Name = ""
Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _
False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _
wdWord10ListBehavior
Selection.TypeText Text:="This is a bulletted list created manually"
Selection.EscapeKey
End Sub
@@ -1,313 +1,0 @@
Attribute VB_Name = "YAMLParser_old"
Option Explicit
Const yamlPath As String = "\\Mac\iCloud\Development\cv\cv.yml"
Const selfIdentifier As String = "___self___"
Const typeIdentifier As String = "___type___"
Const errIdentifier As String = "YAML Error in " & yamlPath
Const malformedTypeError As String = "Malformed YAML code at " & yamlPath & " on line "
Const malformedYAMLError As String = "Malformed type error - this is a problem with the internal dictionary"
Function RemoveEmptyStrings(arr() As String) As String()
Dim tempArray() As String
Dim i As Integer, j As Integer: j = 0
ReDim tempArray(LBound(arr) To UBound(arr))
j = 0
For i = LBound(arr) To UBound(arr)
If Len(arr(i)) > 0 Then
tempArray(j) = arr(i)
j = j + 1
End If
Next i
ReDim Preserve tempArray(0 To j - 1)
RemoveEmptyStrings = tempArray
End Function
Function RegexMatch(inputString As String, pattern As String, Optional isGlobal As Boolean = True) As Boolean
' checks for regex match without instantiating 80 gazillion objects
' parameters
' isGlobal: whether the regex check is global
Dim Regex As Object: Set Regex = CreateObject("VBScript.RegExp")
Regex.pattern = pattern
Regex.Global = isGlobal
RegexMatch = Regex.Test(inputString)
End Function
Function RegexSplit(inputString As String, pattern As String, Optional onlyFirst As Boolean = False, Optional splitBefore As Boolean = False) As String()
' splits array at any pattern that matches a regex
' parameters
' onlyFirst: if true, only splits the first instance of the match, creating an array of length 2
' splitBefore: if true, preserves the actual instance of the match
Dim Regex As Object: Set Regex = CreateObject("VBScript.RegExp")
Dim matches As Object
Dim match As Object
Dim splitParts() As String: ReDim splitParts(0 To 0)
Dim pos As Integer
Dim lastPos As Integer: lastPos = 1
Dim i As Integer: i = 0
' set regex flags
Regex.Global = True
Regex.IgnoreCase = False
Regex.pattern = pattern
Set matches = Regex.Execute(inputString)
' lastPos = 1
' i = 0
For Each match In matches
pos = match.FirstIndex + 1
ReDim Preserve splitParts(i)
splitParts(i) = Mid(inputString, lastPos, pos - lastPos)
If splitBefore Then
lastPos = pos
Else
lastPos = pos + Len(match.Value)
End If
i = i + 1
If onlyFirst Then Exit For
Next match
If lastPos <= Len(inputString) Then
ReDim Preserve splitParts(i)
splitParts(i) = Mid(inputString, lastPos)
End If
' retvrn
RegexSplit = RemoveEmptyStrings(splitParts)
End Function
Function RegexSubstitute(inputString As String, pattern As String, Optional substitution As String = "")
' does what it says on the tin
Dim Regex As Object: Set Regex = CreateObject("VBScript.RegExp")
Regex.pattern = pattern
Regex.IgnoreCase = False
Regex.Global = True
RegexSubstitute = Regex.Replace(inputString, substitution)
End Function
' YAML Layer Parser Pseudocode
' ====
' function GetYAMLLayerAsCollection(String fromYAML) {
' Collection mainDictionary = New Collection();
' if (fromYAML.containsRegex(/\n[A-Za-z]/)) {
' // is a dictionary
' String[] temporaryArray = fromYAML.split(/\n[A-Za-z]/);
' for each x in temporaryArray {
' x.splitByFirstInstanceOf(':\n');
' x[1].replaceAllInstancesOf('
' mainDictionary.add(x[0], x[1]);
' }
' } else if (fromYAML.containsRegex(/\n-/)) {
' // if array, process the array and return it as "self"
' String[] temporaryArray = fromYAML.splitBy('\n-');
' for each x in temporaryArray {
' x.removeAllInstancesOf('\n- ');
' x.replaceAllInstancesOf('\n ', '\n');
' mainDictionary.add("self", temporaryArray);
' }
' } else if (fromYAML.startsWith('"')) {
' mainDictionary.add("self", removeQuotes(fromYAML));
' } else {
' MsgBox("Processing error: neither array, dictionary, nor string");
' }
' }
Function GetYAMLLayerAsDictionary(fromYAML As String) As Dictionary
Dim mainDictionary As Dictionary: Set mainDictionary = New Dictionary
' create regex objects to test for dict, array, and string
'Dim regEx_dict As Object: Set regEx_dict = CreateObject("VBScript.RegExp")
'Dim regEx_arry As Object: Set regEx_arry = CreateObject("VBScript.RegExp")
'Dim regEx_strn As Object: Set regEx_strn = CreateObject("VBScript.RegExp")
'regEx_dict.Global = True: regEx_dict.Pattern = "\n[A-Za-z]"
'regEx_arry.Global = True: regEx_arry.Pattern = "\n-\s"
'regEx_strn.Global = False: regEx_strn.Pattern = "^\s*""(.*?)""\s*$"
Dim parts() As String
If RegexMatch(fromYAML, "(?:\n|\^)\w+:", True) Then
' is a dictionary
parts = RegexSplit(fromYAML, "\n\w+:", False, True)
Dim part As Variant ' not sure why it can't be as string but whatever billy gates
Call mainDictionary.Add(typeIdentifier, "Dictionary") ' identify as dict
For Each part In parts
Dim keyValue() As String: keyValue = RegexSplit(CStr(part), ":\s", True)
' trim trailing \n from category
If UBound(keyValue) > 0 Then
keyValue(0) = RegexSubstitute(keyValue(0), "^\n+")
' trim 2 spaces off of each line if they're there
keyValue(1) = RegexSubstitute(keyValue(1), "^\s{2}")
keyValue(1) = RegexSubstitute(keyValue(1), "\n\s{2}", vbLf)
Call mainDictionary.Add(keyValue(0), keyValue(1))
End If
Next part
ElseIf RegexMatch(fromYAML, "^-\s", True) Then
' is an array
Call mainDictionary.Add(typeIdentifier, "Array")
parts = RegexSplit(fromYAML, "(^|\n)-\s", False)
Dim i As Integer
For i = LBound(parts) To UBound(parts)
parts(i) = RegexSubstitute(parts(i), "\n\s{2}", vbLf)
Next i
Call mainDictionary.Add(selfIdentifier, parts)
ElseIf RegexMatch(fromYAML, "^\s*""(.*?)""\s*$", True) Then
' is a string
Call mainDictionary.Add(typeIdentifier, "String")
Call mainDictionary.Add(selfIdentifier, RegexSubstitute(fromYAML, """", ""))
Else
Call mainDictionary.Add(selfIdentifier, "")
Debug.Print _
"Neither array, dictionary, nor string:" & _
vbCrLf & vbCrLf & fromYAML & vbCrLf & vbCrLf & _
"Make sure all strings are enclosed in double quotes." ', _
'vbOKOnly, "YAML Error")
End If
Set GetYAMLLayerAsDictionary = mainDictionary
End Function
' YAML Traverser Pseudocode
' ===
'
' function TraverseYAML(String fromYAML) {
' Dictionary mainDictionary = GetYAMLLayerAsDictionary(fromYAML);
' if mainDictionary.___type___ = "Dictionary" {
' for each entry in mainDictionary {
' TraverseYAML(entry)
' }
' return mainDictionary;
' } else if mainDictionary.___type___ = "Array" {
' for each entry in mainDictionary.___self___ {
' TraverseYAML(entry)
' }
' return mainDictionary;
' } else if mainDictionary.___type___ = "String" {
' return mainDictionary;
' } else {
' MsgBox("Internal YAML Error")
' }
' }
Function GetYAMLAsDictionary(fromYAML As String) As Dictionary
Dim mainDictionary As Object: Set mainDictionary = GetYAMLLayerAsDictionary(fromYAML)
Dim entry As Variant
If mainDictionary(typeIdentifier) = "Dictionary" Then
For Each entry In mainDictionary
Debug.Print "=== PROCESSING DICTIONARY ENTRY ==="
Debug.Print entry & " => " & mainDictionary(entry)
If entry <> typeIdentifier And entry <> selfIdentifier Then
Set mainDictionary(entry) = GetYAMLAsDictionary(mainDictionary(entry))
End If
Next entry
ElseIf mainDictionary(typeIdentifier) = "Array" Then
Dim i As Integer
Dim subArray() As Object
For i = LBound(mainDictionary(selfIdentifier)) To UBound(mainDictionary(selfIdentifier))
Debug.Print "=== PROCESSING ARRAY ENTRY ==="
Debug.Print mainDictionary(selfIdentifier)(i)
'Set subDictionary = GetYAMLAsDictionary(mainDictionary(selfIdentifier)(i))
'Set mainDictionary(selfIdentifier)(i) = subDictionary
ReDim Preserve subArray(i)
Set subArray(i) = GetYAMLAsDictionary(CStr(mainDictionary(selfIdentifier)(i)))
Next i
mainDictionary(selfIdentifier) = subArray
ElseIf mainDictionary(typeIdentifier) <> "String" Then
Debug.Print malformedTypeError ', vbOKOnly, errIdentifier)
End If
Set GetYAMLAsDictionary = mainDictionary
End Function
' YAML Cleaner Pseudocode
' =====
' function YAMLCleaner(Dictionary mainDictionary) {
' for each entry in mainDictionary {
' if entry(typeIdentifier) == "Dictionary" {
' for each secondOrderEntry in entry {
' YAMLCleaner(secondOrderEntry)
' }
' } else if entry(typeIdentifier) == "Array" {
' for each secondOrderEntry in entry(selfIdentifier) {
' YAMLCleaner(secondOrderEntry)
' }
' }
' if entry(typeIdentifier) != "Dictionary" {
' mainDictionary(entry) = mainDictionary(entry)(selfIdentifier)
' }
' }
' return mainDictionary;
' }
Function YAMLCleaner(mainDictionary As Dictionary) As Dictionary
Dim entry As Variant
If mainDictionary(typeIdentifier) = "Array" Then ' go through array and yamlclean it
Dim i As Integer
Debug.Print JsonConverter.ConvertToJson(mainDictionary)
For i = LBound(mainDictionary(selfIdentifier)) To UBound(mainDictionary(selfIdentifier))
'If IsObject(mainDictionary(selfIdentifier)(i)) Then
'Set mainDictionary(selfIdentifier)(i) = YAMLCleaner(mainDictionary(selfIdentifier)(i))
'Else
' Debug.Print "encountered non-object"
'End If
Next i
End If
If mainDictionary(typeIdentifier) = "Dictionary" Then 'iterate through dict and yamlclena it
For Each entry In mainDictionary
If entry <> typeIdentifier Then
Set mainDictionary(entry) = YAMLCleaner(mainDictionary(entry))
End If
Next entry
End If
For Each entry In mainDictionary
If mainDictionary(typeIdentifier) = "Dictionary" And mainDictionary(entry)(typeIdentifier) <> "Dictionary" And entry <> typeIdentifier And entry <> selfIdentifier Then
Debug.Print "processing " & entry & " which is " & mainDictionary(entry)(typeIdentifier)
If IsObject(mainDictionary(entry)(selfIdentifier)) Then
Set mainDictionary(entry) = mainDictionary(entry)(selfIdentifier)
Else
mainDictionary(entry) = mainDictionary(entry)(selfIdentifier)
End If
End If
Next entry
' destroy type identifier?
Set YAMLCleaner = mainDictionary
End Function
Function GetFileAsString(filePath As String) As String
' Dim fileContent As String
Dim line As String
Dim fileNumber As Integer
'filePath = "\\Mac\iCloud\Development\cv\cv.yml"
fileNumber = FreeFile()
Open filePath For Input As fileNumber
Do While Not EOF(fileNumber)
Line Input #fileNumber, line
GetFileAsString = GetFileAsString & line & vbCrLf
Loop
End Function
Sub TryFunction()
Dim fileString As String: fileString = GetFileAsString("\\Mac\iCloud\Development\cv\cv.yml")
Dim yamlLayer As Object
Set yamlLayer = GetYAMLLayerAsDictionary(fileString)
Dim yamlWholeDict As Object: Set yamlWholeDict = GetYAMLAsDictionary(fileString)
'Debug.Print JsonConverter.ConvertToJson(yamlWholeDict, 2, 2)
Dim yamlCleanDict As Object: Set yamlCleanDict = YAMLCleaner(yamlWholeDict)
Debug.Print JsonConverter.ConvertToJson(yamlCleanDict, 2, 2)
End Sub