1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
'**********************************************************************************************************
' Name: dictionaryToArray
' Author: mielk | 2013-04-10
'
' Comment: Convert the given dictionary into two-dimensional array.
' Result array can contain values only, keys only or both, depending on the given
' optional parameters includeKeys and includeValues.
'
' Parameters:
' dict Dictionary to be converted into an array.
' includeKeys Optional parameter determining if keys are to be included in the result array.
' Default value of this parameter is True.
' includeValues Optional parameter determining if values are to be included in the result array.
' Default value of this parameter is True.
'
' Returns:
' Variant() Array of the keys and values from the given dictionary.
'
'
' Exceptions:
' IllegalTypeException Thrown if the given parameter is not a dictionary.
' IllegalParameters Thrown if both parameters (includeKeys and includeValues) are set to
' False.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2013-04-10 mielk Function created.
'**********************************************************************************************************
Public Function dictionaryToArray(dict As Variant, Optional includeKeys As Boolean = True, _
Optional includeValues As Boolean = True) As Variant()
Const METHOD_NAME As String = "dictionaryToArray"
'------------------------------------------------------------------------------------------------------
Const ARRAY_BASE_INDEX As Long = 0
Const DICTIONARY_TYPENAME As String = "Dictionary"
'------------------------------------------------------------------------------------------------------
Dim varKey As Variant
Dim arr() As Variant
Dim lngItem As Long
Dim columns As Integer
'------------------------------------------------------------------------------------------------------
'Check if the given parameter dict is a dictionary. -------------------------------------------------|
If VBA.StrComp(VBA.TypeName(dict), DICTIONARY_TYPENAME, vbTextCompare) Then _
GoTo IllegalTypeException '|
'----------------------------------------------------------------------------------------------------|
'Check if at least one parameter from [includeKeys], [includeValues] is set to True. Otherwise, -----|
'there is no point to continue with this function, since user selected no data to be included. '|
If Not includeKeys And Not includeValues Then GoTo IllegalParameters '|
columns = VBA.IIf(includeKeys, 1, 0) + VBA.IIf(includeValues, 1, 0) '|
'----------------------------------------------------------------------------------------------------|
'If the given dictionary is empty, empty array will be returned. ------------------------------------|
If dict.Count Then '|
'|
'Resize final table [arr] to be big enough for all the items from the given dictionary. -----| '|
ReDim arr(1 To columns, 1 To dict.Count) '| '|
For Each varKey In dict.keys '| '|
lngItem = lngItem + 1 '| '|
'| '|
'Appending keys to the final array (if applicable). ---------------------------------| '| '|
If includeKeys Then '| '| '|
'| '| '|
'Before adding value to the result array check if it is an object or --------| '| '| '|
'a primitive value and apply proper action. '| '| '| '|
If VBA.IsObject(varKey) Then '| '| '| '|
Set arr(1, lngItem) = varKey '| '| '| '|
Else '| '| '| '|
arr(1, lngItem) = varKey '| '| '| '|
End If '| '| '| '|
'----------------------------------------------------------------------------| '| '| '|
'| '| '|
End If '| '| '|
'------------------------------------------------------------------------------------| '| '|
'| '|
'| '|
'Appending values to the final array (if applicable). -------------------------------| '| '|
If includeValues Then '| '| '|
'| '| '|
'Before adding value to the result array check if it is an object or --------| '| '| '|
'a primitive value and apply proper action. '| '| '| '|
If VBA.IsObject(varKey) Then '| '| '| '|
Set arr(columns, lngItem) = varKey '| '| '| '|
Else '| '| '| '|
arr(columns, lngItem) = varKey '| '| '| '|
End If '| '| '| '|
'----------------------------------------------------------------------------| '| '| '|
'| '| '|
End If '| '| '|
'------------------------------------------------------------------------------------| '| '|
'| '|
Next varKey '| '|
'--------------------------------------------------------------------------------------------| '|
'|
End If '|
'----------------------------------------------------------------------------------------------------|
'Assign the final table to the result variable.
dictionaryToArray = arr
'==========================================================================================================
ExitPoint:
Exit Function
'----------------------------------------------------------------------------------------------------------
IllegalTypeException:
'Error handling for the case if the given parameter is not a dictionary.
GoTo ExitPoint
IllegalParameters:
'Error handling for the case if both parameters - includeKeys and includeValues - are set to False.
GoTo ExitPoint
End Function