Get dictionary keys


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
'**********************************************************************************************************
' Name:                 getDictionaryKeys
' Author:               mielk | 2013-04-10
'
' Comment:              Returns set of keys of the specified dictionary as a one-dimensional array.
'
' Parameters:
'   dict                Dictionary which keys are to be returned.
'
' Returns:
'   Variant()           Array of the keys from the given dictionary.
'
'
' Exceptions:
'   IllegalTypeException            Thrown if the given parameter is not a dictionary.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2013-04-10        mielk       Function created.
'**********************************************************************************************************
Public Function getDictionaryKeys(dict As Variant) As Variant()
    Const METHOD_NAME As String = "getDictionaryKeys"
    '------------------------------------------------------------------------------------------------------
    Const DICTIONARY_TYPENAME As String = "Dictionary"
    '------------------------------------------------------------------------------------------------------
    Dim varKey As Variant
    Dim arr() As Variant
    Dim lngItem As Long
    '------------------------------------------------------------------------------------------------------


    'Check if the given parameter dict is a dictionary. -------------------------------------------------|
    If VBA.StrComp(VBA.TypeName(dict), DICTIONARY_TYPENAME, vbTextCompare) Then _
                                                                            GoTo IllegalTypeException   '|
    '----------------------------------------------------------------------------------------------------|


    '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 dict.Count)                                                                  '|  '|
        For Each varKey In dict.keys                                                                '|  '|
            lngItem = lngItem + 1                                                                   '|  '|
                                                                                                    '|  '|
            '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(lngItem) = varKey                                                       '|  '|  '|
            Else                                                                                '|  '|  '|
                arr(lngItem) = varKey                                                           '|  '|  '|
            End If                                                                              '|  '|  '|
            '------------------------------------------------------------------------------------|  '|  '|
                                                                                                    '|  '|
        Next varKey                                                                                 '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
    End If                                                                                              '|
    '----------------------------------------------------------------------------------------------------|


    'Assign the final table to the result variable.
    getDictionaryKeys = arr


'==========================================================================================================
ExitPoint:
    Exit Function

'----------------------------------------------------------------------------------------------------------
IllegalTypeException:
    '(...)
    'Error handling for the case if the given parameter is not a dictionary.

    GoTo ExitPoint

End Function