I was trying to help a user out in a forum get a listing of Values from a specific registry Key and thought I’d share my solution here.
Per the usual, there are a number of different ways to read the registry, but I found that using WMI is very simple.
To simplify things, I added the use of a ‘RegistryClass’ Enum so you don’t need to remember the various registry class constants.
Enough talk, here’s the code!
Enum RegistryClass
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
HKEY_CURRENT_CONFIG = &H80000005
End Enum
'---------------------------------------------------------------------------------------
' Procedure : WMI_EnumerateKeyValues
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Enumerate all the Values in the specified registry key
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Late Binding -> None required
' Early Binding -> Microsoft WMI Scripting VX.X Library
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sRegClass : The Registry Class that the parent key is in
' sParentKey: The Key to enumerate the subkeys of
'
' Usage:
' ~~~~~~
' Call WMI_EnumerateKeyValues(HKEY_CURRENT_USER, "Control Panel\International")
' Call WMI_EnumerateKeyValues(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\msaccess.exe")
'
' Revision History:
' Rev Date(yyyy-mm-dd) Description
' **************************************************************************************
' 1 2022-02-03 Initial Public Release
'---------------------------------------------------------------------------------------
Sub WMI_EnumerateKeyValues(ByVal sRegClass As RegistryClass, ByVal sParentKey As String)
On Error GoTo Error_Handler
#Const WMI_EarlyBind = False 'True => Early Binding / False => Late Binding
#If WMI_EarlyBind = True Then
Dim oWMI As WbemScripting.SWbemObject
#Else
Dim oWMI As Object
#End If
Dim aNames As Variant
Dim aTypes As Variant
Dim sValue As String
Dim i As Long 'Sequential Counter
Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
oWMI.EnumValues sRegClass, sParentKey, aNames, aTypes 'Get all the subkeys within the sParentKey
Debug.Print "No", "Key", "Type", "Value" 'Header
Debug.Print String(80, "-") 'Header
For i = 0 To UBound(aNames) 'Iterate through each subkey get name, type and value
oWMI.GetStringValue sRegClass, sParentKey, aNames(i), sValue
Debug.Print i + 1, _
aNames(i), _
Switch(aTypes(i) = 1, "REG_SZ", _
aTypes(i) = 2, "REG_EXPAND_SZ", _
aTypes(i) = 3, "REG_BINARY", _
aTypes(i) = 4, "REG_DWORD", _
aTypes(i) = 7, "REG_MULTI_SZ", _
aTypes(i) = 11, "REG_QWORD"), _
sValue
Next i
Error_Handler_Exit:
On Error Resume Next
If Not oWMI Is Nothing Then Set oWMI = Nothing
Exit Sub
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: WMI_EnumerateKeyValues" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Sub
You can then use the procedure by simply doing:
Call WMI_EnumerateKeyValues(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\msaccess.exe")
which will return something along the lines of:
No Key Type Value -------------------------------------------------------------------------------- 1 REG_SZ C:\PROGRA~2\MICROS~1\Office15\MSACCESS.EXE 2 Path REG_SZ C:\Program Files (x86)\Microsoft Office\Office15\ 3 useURL REG_SZ 1
Code Features
This code
- can be used as both Early or Late Binding, the choice is yours and set by changing the value of the WMI_EarlyBind constant.
- is bitness independent (works in both 32 and 64-bit installations)
- is application independent (should work in any VBA applications – Access, Excel, Outlook, PowerPoint, Word, …)
