Use of CopyMem for Collection

[Juggler_IN]

The attached code below outputs the Keys of a collection, I want to modify it to fetch the collection items instead. My understanding is that the line (Get MemoryAddress of Element-Key): KeyPtr = PeekLong(ItemPtr + 16) needs to be modified to (Get MemoryAddress of Element-Item): KeyPtr = PeekLong(ItemPtr + 8). And, "Temp(index) = PeekBSTR(KeyPtr)" to "Call MemCopy(VBA.VarPtr(Value), KeyPtr, LenB(Value))" since we are now dealing with the values of the collection items, not their keys.

With the changes, no value is getting passed. An empty array is getting returned. Any suggestions?

My code:

Function CollectionItems(oColl As Collection) As Variant()

'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 items
    Dim Temp() As Variant
    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-Value
        KeyPtr = PeekLong(ItemPtr + 8)

        'Peek Value and add to temporary array (if present)
        If KeyPtr <> 0 Then
            Dim Value As Variant
            Call MemCopy(VBA.VarPtr(Value), KeyPtr, LenB(Value))
            Temp(index) = Value
            ' Temp(index) = VBA.VarPtrToObject(KeyPtr)
        End If

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

    Wend

    'Assign temporary array as Return-Value
    CollectionItems = Temp
End Function

And reference code:

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