Function GetHive(RegPath)
    Select Case Left(RegPath, InStr(1, RegPath, "\") - 1)
    Case "HKEY_CLASSES_ROOT"
        GetHive -2147483648#
    Case "HKEY_CURRENT_USER"
        GetHive = -2147483647
    Case "HKEY_LOCAL_MACHINE"
        GetHive = -2147483646
    Case "HKEY_USERS"
        GetHive = -2147483645
    Case "HKEY_CURRENT_CONFIG"
        GetHive = -2147483643
    End Select
End Function

Sub GetAllSubKeys(ByRef strRegPath, ByRef arrSubKeys, ByVal strComputer)
' В параметре процедуры "strRegPath" необходимо указать полностью раздел Windows реестра.
' Например так: "HKEY_CURRENT_USER\Software".
Dim oWMI, Hive, strPath
On Error Resume Next
If Len(strComputer) = 0 Then strComputer = "."
Hive = GetHive(strRegPath)
If Hive = 0 Then
    MsgBox "Указан неверный Windows реестр """ & strRegPath & """!", vbExclamation + vbSystemModal
    Exit Sub
End If
Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
    strComputer & "\root\default:StdRegProv")
strPath = Mid(strRegPath, InStr(1, strRegPath, "\") + 1)
oWMI.EnumKey Hive, strPath, arrSubKeys
If IsNull(arrSubKeys) Then
    arrSubKeys = Split("", ";")
    MsgBox "Ветка """ & strRegPath & """ либо не существует, либо не имеет подразделов!", vbExclamation + vbSystemModal
End If
End Sub

Sub GetAllKeyValues(ByRef strRegPath, ByRef arrValueNames, ByRef arrValueTypes, ByVal strComputer)
Dim oWMI, Hive, strPath, i
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
On Error Resume Next
If Len(strComputer) = 0 Then strComputer = "."
Hive = GetHive(strRegPath)
If Hive = 0 Then
    MsgBox "Указан неверный Windows реестр """ & strRegPath & """!", vbExclamation + vbSystemModal
    Exit Sub
End If
Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
    strComputer & "\root\default:StdRegProv")
strPath = Mid(strRegPath, InStr(1, strRegPath, "\") + 1)
oWMI.EnumValues Hive, strPath, arrValueNames, arrValueTypes
If IsNull(arrValueNames) Then
    arrValueNames = Split("", ";")
    arrValueTypes = Split("", ";")
    MsgBox "Ветка """ & strRegPath & """ либо не существует, либо не имеет ключей.", _
        vbExclamation + vbSystemModal
Else
    strPath = ""
    For i = 0 To UBound(arrValueNames)
        Select Case arrValueTypes(i)
        Case REG_SZ
            strPath = strPath & ";String"
        Case REG_EXPAND_SZ
            strPath = strPath & ";Expanded String"
        Case REG_BINARY
            strPath = strPath & ";Binary"
        Case REG_DWORD
            strPath = strPath & ";DWORD"
        Case REG_MULTI_SZ
            strPath = strPath & ";Multi String"
        End Select
    Next
    strPath = Mid(strPath, 2)
    arrValueTypes = Split(strPath, ";")
End If
End Sub