VBA collection list of keys

Question

After I add some values to the VBA collection  is there any way to retain the list of all keys   For example  Dim coll as new  Collection Dim str1  str2  str3 str1  first string  str2  second string  str3  third string  coll add str1   first key  coll add str2   second key  coll add str3   third key    I know how to retain the list of strings   first string second string third string   Once again  is there any way to retain the keys   first key second key third key   Note  I m using VBA through AutoCAD 2007

User · Answer

You can snoop around in your memory using RTLMoveMemory and retrieve the desired information directly from there:

32-Bit:

Option Explicit

'Provide direct memory access:
Public Declare Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByVal Destination As Long, _
    ByVal Source As Long, _
    ByVal Length As Long)


Function CollectionKeys(oColl As Collection) As String()

    'Declare Pointer- / Memory-Address-Variables
    Dim CollPtr As Long
    Dim KeyPtr As Long
    Dim ItemPtr As Long

    'Get MemoryAddress of Collection Object
    CollPtr = VBA.ObjPtr(oColl)

    'Peek ElementCount
    Dim ElementCount As Long
    ElementCount = PeekLong(CollPtr + 16)

        'Verify ElementCount
        If ElementCount <> oColl.Count Then
            'Something's wrong!
            Stop
        End If

    'Declare Simple Counter
    Dim index As Long

    'Declare Temporary Array to hold our keys
    Dim Temp() As String
    ReDim Temp(ElementCount)

    'Get MemoryAddress of first CollectionItem
    ItemPtr = PeekLong(CollPtr + 24)

    'Loop through all CollectionItems in Chain
    While Not ItemPtr = 0 And index < ElementCount

        'increment Index
        index = index + 1

        'Get MemoryAddress of Element-Key
        KeyPtr = PeekLong(ItemPtr + 16)

        'Peek Key and add to temporary array (if present)
        If KeyPtr <> 0 Then
           Temp(index) = PeekBSTR(KeyPtr)
        End If

        'Get MemoryAddress of next Element in Chain
        ItemPtr = PeekLong(ItemPtr + 24)

    Wend

    'Assign temporary array as Return-Value
    CollectionKeys = Temp

End Function


'Peek Long from given MemoryAddress
Public Function PeekLong(Address As Long) As Long

  If Address = 0 Then Stop
  Call MemCopy(VBA.VarPtr(PeekLong), Address, 4&)

End Function

'Peek String from given MemoryAddress
Public Function PeekBSTR(Address As Long) As String

    Dim Length As Long

    If Address = 0 Then Stop
    Length = PeekLong(Address - 4)

    PeekBSTR = Space(Length \ 2)
    Call MemCopy(VBA.StrPtr(PeekBSTR), Address, Length)

End Function

64-Bit:

Option Explicit

'Provide direct memory access:
Public Declare PtrSafe Sub MemCopy Lib "kernel32" Alias "RtlMoveMemory" ( _
     ByVal Destination As LongPtr, _
     ByVal Source As LongPtr, _
     ByVal Length As LongPtr)



Function CollectionKeys(oColl As Collection) As String()

    'Declare Pointer- / Memory-Address-Variables
    Dim CollPtr As LongPtr
    Dim KeyPtr As LongPtr
    Dim ItemPtr As LongPtr

    'Get MemoryAddress of Collection Object
    CollPtr = VBA.ObjPtr(oColl)

    'Peek ElementCount
    Dim ElementCount As Long
    ElementCount = PeekLong(CollPtr + 28)

        'Verify ElementCount
        If ElementCount <> oColl.Count Then
            'Something's wrong!
            Stop
        End If

    'Declare Simple Counter
    Dim index As Long

    'Declare Temporary Array to hold our keys
    Dim Temp() As String
    ReDim Temp(ElementCount)

    'Get MemoryAddress of first CollectionItem
    ItemPtr = PeekLongLong(CollPtr + 40)

    'Loop through all CollectionItems in Chain
    While Not ItemPtr = 0 And index < ElementCount

        'increment Index
        index = index + 1

        'Get MemoryAddress of Element-Key
        KeyPtr = PeekLongLong(ItemPtr + 24)

        'Peek Key and add to temporary array (if present)
        If KeyPtr <> 0 Then
           Temp(index) = PeekBSTR(KeyPtr)
        End If

        'Get MemoryAddress of next Element in Chain
        ItemPtr = PeekLongLong(ItemPtr + 40)

    Wend

    'Assign temporary array as Return-Value
    CollectionKeys = Temp

End Function


'Peek Long from given Memory-Address
Public Function PeekLong(Address As LongPtr) As Long

  If Address = 0 Then Stop
  Call MemCopy(VBA.VarPtr(PeekLong), Address, 4^)

End Function

'Peek LongLong from given Memory Address
Public Function PeekLongLong(Address As LongPtr) As LongLong

  If Address = 0 Then Stop
  Call MemCopy(VBA.VarPtr(PeekLongLong), Address, 8^)

End Function

'Peek String from given MemoryAddress
Public Function PeekBSTR(Address As LongPtr) As String

    Dim Length As Long

    If Address = 0 Then Stop
    Length = PeekLong(Address - 4)

    PeekBSTR = Space(Length \ 2)
    Call MemCopy(VBA.StrPtr(PeekBSTR), Address, CLngLng(Length))

End Function

User · Answer

If you intend to use the default VB6 Collection  then the easiest you can do is   col1 add array  first key    first string     first key  col1 add array  second key    second string     second key  col1 add array  third key    third string     third key    Then you can list all values   Dim i As Variant  For Each i In col1   Debug Print i 1  Next   Or all keys   Dim i As Variant  For Each i In col1   Debug Print i 0  Next

User · Answer

You can create a small class to hold the key and value  and then store objects of that class in the collection   Class KeyValue   Public key As String Public value As String Public Sub Init k As String  v As String      key   k     value   v End Sub   Then to use it   Public Sub Test       Dim col As Collection  kv As KeyValue     Set col   New Collection     Store col   first key    first string      Store col   second key    second string      Store col   third key    third string      For Each kv In col         Debug Print kv key  kv value     Next kv End Sub  Private Sub Store col As Collection  k As String  v As String      If  Contains col  k   Then         Set kv   col k          kv value   v     Else         Set kv   New KeyValue         kv Init k  v         col Add kv  k     End If End Sub  Private Function Contains col As Collection  key As String  As Boolean     On Error GoTo NotFound     Dim itm As Object     Set itm   col key      Contains   True MyExit      Exit Function NotFound      Contains   False     Resume MyExit End Function   This is of course similar to the Dictionary suggestion  except without any external dependencies  The class can be made more complex as needed if you want to store more information

User · Answer

An alternative solution is to store the keys in a separate Collection    Initialise these somewhere  Dim Keys As Collection  Values As Collection   Add types for K and V as necessary  Sub Add K  V   Keys Add K Values Add V  K End Sub   You can maintain a separate sort order for the keys and the values  which can be useful sometimes

User · Answer

You can easily iterate you collection  The example below is for the special Access TempVars collection  but works with any regular collection   Dim tv As Long For tv   0 To TempVars Count - 1     Debug Print TempVars tv  Name  TempVars tv  Value Next tv

User · Answer

I don t thinks that possible with a vanilla collection without storing the key values in an independent array    The easiest alternative to do this is to add a reference to the Microsoft Scripting Runtime  amp  use a more capable Dictionary instead   Dim dict As Dictionary Set dict   New Dictionary  dict Add  key1    value1  dict Add  key2    value2   Dim key As Variant For Each key In dict Keys     Debug Print  Key     amp  key   Value     amp  dict Item key  Next

[vba] VBA collection: list of keys

Examples related to vba

Examples related to collections