Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_MULTI_SZ = 7
Public Const ERROR_MORE_DATA = 234
Public Const KEY_READ = &H20019
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
 
public Function EnumRegistryKeys(ByVal hKey As Long, ByVal KeyName As String) As Collection
    Dim Handle As Long
    Dim length As Long
    Dim index As Long
    Dim subkeyName As String
 
    ' initialize the result collection
    Set EnumRegistryKeys = New Collection
 
    ' Open the key, exit if not found
    If Len(KeyName) Then
        If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, Handle) Then Exit Function
        ' in all case the subsequent functions use hKey
        hKey = Handle
    End If
 
    Do
        ' this is the max length for a key name
        length = 260
        subkeyName = Space$(length)
        ' get the N-th key, exit the loop if not found
        If RegEnumKey(hKey, index, subkeyName, length) Then Exit Do
 
        ' add to the result collection
        subkeyName = Left$(subkeyName, InStr(subkeyName, vbNullChar) - 1)
        EnumRegistryKeys.Add subkeyName, subkeyName
        ' prepare to query for next key
        index = index + 1
    Loop
 
    ' Close the key, if it was actually opened
    If Handle Then RegCloseKey Handle
 
End Function
 
Public Function EnumRegistryValues(ByVal hKey As Long, ByVal KeyName As String) As Collection
 
    Dim Handle As Long
    Dim index As Long
    Dim valueType As Long
    Dim name As String
    Dim nameLen As Long
    Dim resLong As Long
    Dim resString As String
    Dim dataLen As Long
    Dim valueInfo(0 To 1) As Variant
    Dim retVal As Long
 
    ' initialize the result
    Set EnumRegistryValues = New Collection
 
    ' Open the key, exit if not found.
    If Len(KeyName) Then
        If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, Handle) Then Exit Function
        ' in all cases, subsequent functions use hKey
        hKey = Handle
    End If
 
    Do
        ' this is the max length for a key name
        nameLen = 260
        name = Space$(nameLen)
        ' prepare the receiving buffer for the value
        dataLen = 4096
        ReDim resBinary(0 To dataLen - 1) As Byte
 
        ' read the value's name and data
        ' exit the loop if not found
        retVal = RegEnumValue(hKey, index, name, nameLen, ByVal 0&, valueType, _
            resBinary(0), dataLen)
 
        ' enlarge the buffer if you need more space
        If retVal = ERROR_MORE_DATA Then
            ReDim resBinary(0 To dataLen - 1) As Byte
            retVal = RegEnumValue(hKey, index, name, nameLen, ByVal 0&, _
                valueType, resBinary(0), dataLen)
        End If
        ' exit the loop if any other error (typically, no more values)
        If retVal Then Exit Do
 
        ' retrieve the value's name
        valueInfo(0) = Left$(name, nameLen)
 
        ' return a value corresponding to the value type
        Select Case valueType
            Case REG_DWORD
                CopyMemory resLong, resBinary(0), 4
                valueInfo(1) = resLong
            Case REG_SZ, REG_EXPAND_SZ
                ' copy everything but the trailing null char
                resString = Space$(dataLen - 1)
                CopyMemory ByVal resString, resBinary(0), dataLen - 1
                valueInfo(1) = resString
            Case REG_BINARY
                ' shrink the buffer if necessary
                If dataLen < UBound(resBinary) + 1 Then
                    ReDim Preserve resBinary(0 To dataLen - 1) As Byte
                End If
                valueInfo(1) = resBinary()
            Case REG_MULTI_SZ
                ' copy everything but the 2 trailing null chars
                resString = Space$(dataLen - 2)
                CopyMemory ByVal resString, resBinary(0), dataLen - 2
                valueInfo(1) = resString
            Case Else
                ' Unsupported value type - do nothing
        End Select
 
        ' add the array to the result collection
        ' the element's key is the value's name
        'EnumRegistryValues.Add valueInfo, valueInfo(0)
        EnumRegistryValues.Add valueInfo(0)
        EnumRegistryValues.Add valueInfo(1)
 
        index = index + 1
    Loop
 
    ' Close the key, if it was actually opened
    If Handle Then RegCloseKey Handle
 
End Function

Dim RetCol, TColl As New Collection
Set RetCol = EnumRegistryValues(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run")