Say I have the following Key
HKEY_CURRENT_USER/Software/test/key1
HKEY_CURRENT_USER/Software/test/key2
How do I get all the keys under HKEY_CURRENT_USER/Software/test?
Thank you
Printable View
Say I have the following Key
HKEY_CURRENT_USER/Software/test/key1
HKEY_CURRENT_USER/Software/test/key2
How do I get all the keys under HKEY_CURRENT_USER/Software/test?
Thank you
Code:'* Assume you have keys and your form has a cmdLoad command button
'* HKEY_CURRENT_USER\Software\Test\New Key #1\New Value #1
'* HKEY_CURRENT_USER\Software\Test\New Key #2\New Value #1
'* So we first get the collection of sub keys i.e New Key #1 and New Key #2
'* then get their corresponding values...
Option Explicit
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const ERROR_SUCCESS = 0&
Const REG_SZ = 1
Const REG_BINARY = 3
Const REG_DWORD = 4
Private Type HKEY_CACHE
hKey As Long
strHkey As String
End Type
Private hkeyCache() As HKEY_CACHE
Private Declare Function OSRegCloseKey Lib "advapi32" Alias "RegCloseKey" ( _
ByVal hKey As Long) As Long
Private Declare Function OSRegOpenKey Lib "advapi32" Alias "RegOpenKeyA" ( _
ByVal hKey As Long, _
ByVal lpszSubKey As String, _
phkResult As Long) As Long
Private Declare Function OSRegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" ( _
ByVal hKey As Long, _
ByVal lpszValueName As String, _
ByVal dwReserved As Long, _
lpdwType As Long, _
lpbData As Any, _
cbData As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" ( _
ByVal hKey As Long, _
ByVal dwIndex As Long, _
ByVal lpName As String, _
ByVal cbName As Long) As Long
Const KEY_READ = &H20019
'* This function gives you a collection of subkeys from a given keyName
Function EnumRegistryKeys(ByVal hKey As Long, ByVal KeyName As String) As Collection
'* Code for this Function picked up from www.vb2themax.com
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
'* open a registry key
Function RegOpenKey(ByVal hKey As Long, ByVal lpszSubKey As String, phkResult As Long) As Boolean
Dim lResult As Long
Dim strHkey As String
On Error GoTo 0
strHkey = strGetHKEYString(hKey)
lResult = OSRegOpenKey(hKey, lpszSubKey, phkResult)
If lResult = ERROR_SUCCESS Then
RegOpenKey = True
Else
RegOpenKey = False
End If
End Function
Private Function strGetHKEYString(ByVal hKey As Long) As String
Dim strKey As String
'Is the hkey predefined?
strKey = strGetPredefinedHKEYString(hKey)
If strKey <> "" Then
strGetHKEYString = strKey
Exit Function
End If
End Function
Private Function strGetPredefinedHKEYString(ByVal hKey As Long) As String
Select Case hKey
Case HKEY_CLASSES_ROOT
strGetPredefinedHKEYString = "HKEY_CLASSES_ROOT"
Case HKEY_CURRENT_USER
strGetPredefinedHKEYString = "HKEY_CURRENT_USER"
Case HKEY_LOCAL_MACHINE
strGetPredefinedHKEYString = "HKEY_LOCAL_MACHINE"
Case HKEY_USERS
strGetPredefinedHKEYString = "HKEY_USERS"
End Select
End Function
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String, strData As String) As Boolean
Dim lResult As Long
Dim lValueType As Long
Dim strBuf As String
Dim lDataBufSize As Long
RegQueryStringValue = False
On Error GoTo 0
' Get length/data type
lResult = OSRegQueryValueEx(hKey, strValueName, 0&, lValueType, ByVal 0&, lDataBufSize)
If lResult = ERROR_SUCCESS Then
If lValueType = REG_SZ Then
strBuf = String(lDataBufSize, " ")
lResult = OSRegQueryValueEx(hKey, strValueName, 0&, 0&, ByVal strBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
RegQueryStringValue = True
strData = StripTerminator(strBuf)
End If
End If
End If
End Function
Function StripTerminator(ByVal strString As String) As String
Dim intZeroPos As Integer
intZeroPos = InStr(strString, Chr$(0))
If intZeroPos > 0 Then
StripTerminator = Left$(strString, intZeroPos - 1)
Else
StripTerminator = strString
End If
End Function
Function RegCloseKey(ByVal hKey As Long) As Boolean
Dim lResult As Long
On Error GoTo 0
lResult = OSRegCloseKey(hKey)
RegCloseKey = (lResult = ERROR_SUCCESS)
End Function
Private Function GetKeyValue(ByVal SubKey As String) As String
Dim Key As Long
Dim strDisplayName As String
Dim lcStrRegPath As String
'* Give the key you want to retrieve here!!!
Const strKEY_DISPLAYNAME$ = "New Value #1"
lcStrRegPath = "Software\Test\" & SubKey
If RegOpenKey(HKEY_CURRENT_USER, lcStrRegPath, Key) Then
If RegQueryStringValue(Key, strKEY_DISPLAYNAME, strDisplayName) Then
'* retrieve key value here from strDisplayName
GetKeyValue = strDisplayName
RegCloseKey Key
Exit Function
End If
GetKeyValue = ""
RegCloseKey Key
End If
GetKeyValue = ""
End Function
Private Sub cmdLoad_Click()
Dim lcStrRegPath As String
Dim lcObjColl As Collection
Dim lcIntCount As Integer
Dim lcintI As Integer
Dim lcStrKeyValue As String
'* Give Subkey here
lcStrRegPath = "Software\Test"
Set lcObjColl = EnumRegistryKeys(HKEY_CURRENT_USER, lcStrRegPath)
lcIntCount = lcObjColl.Count
For lcintI = 1 To lcIntCount
'* Loop in collection of Registry values to get value of key
lcStrKeyValue = GetKeyValue(lcObjColl.Item(lcintI))
If Not Len(Trim$(lcStrKeyValue)) = 0 Then
Debug.Print "Key values = " & lcStrKeyValue
End If
Next lcintI
End Sub
VB Code: