Option Compare Database
Option Explicit

Private Declare Function RegEnumValue Lib "advapi32.dll" _
                   Alias "RegEnumValueA" _
                   (ByVal hKey As Long, _
                   ByVal dwIndex As Long, _
                   ByVal lpValueName As String, _
                   lpcbValueName As Long, _
                   ByVal lpReserved As Long, _
                   lpType As Long, _
                   lpData As Any, _
                   lpcbData 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 RegCloseKey Lib "advapi32.dll" _
        (ByVal hKey As Long) As Long

    Const HKEY_CLASSES_ROOT = &H80000000
    Const HKEY_CURRENT_USER = &H80000001
    Const HKEY_LOCAL_MACHINE = &H80000002
    Const HKEY_USERS = &H80000003

    Const ERROR_SUCCESS = 0&

    Const SYNCHRONIZE = &H100000
    Const STANDARD_RIGHTS_READ = &H20000
    Const STANDARD_RIGHTS_WRITE = &H20000
    Const STANDARD_RIGHTS_EXECUTE = &H20000
    Const STANDARD_RIGHTS_REQUIRED = &HF0000
    Const STANDARD_RIGHTS_ALL = &H1F0000
    Const KEY_QUERY_VALUE = &H1
    Const KEY_SET_VALUE = &H2
    Const KEY_CREATE_SUB_KEY = &H4
    Const KEY_ENUMERATE_SUB_KEYS = &H8
    Const KEY_NOTIFY = &H10
    Const KEY_CREATE_LINK = &H20
    Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
                      KEY_QUERY_VALUE Or _
                      KEY_ENUMERATE_SUB_KEYS Or _
                      KEY_NOTIFY) And _
                      (Not SYNCHRONIZE))

    Const REG_DWORD = 4
    Const REG_BINARY = 3
    Const REG_SZ = 1

Private Sub reg_keys_list()
    Dim lngKeyHandle As Long
    Dim lngResult As Long
    Dim lngCurIdx As Long
    Dim strValue As String
    Dim lngValueLen As Long
    Dim lngData As Long
    Dim lngDataLen As Long
    Dim strResult As String

    lngResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
            "SOFTWARE\Microsoft\Windows\CurrentVersion\SharedDlls", _
             0&, _
             KEY_READ, _
             lngKeyHandle)
    
    If lngResult <> ERROR_SUCCESS Then
        MsgBox "Cannot open key"
        Exit Sub
    End If
    
    lngCurIdx = 0
    Do
       lngValueLen = 2000
       strValue = String(lngValueLen, 0)
       lngDataLen = 2000
    
       lngResult = RegEnumValue(lngKeyHandle, _
                                lngCurIdx, _
                                ByVal strValue, _
                                lngValueLen, _
                                0&, _
                                REG_DWORD, _
                                ByVal lngData, _
                                lngDataLen)
       lngCurIdx = lngCurIdx + 1
    
    If lngResult = ERROR_SUCCESS Then
       strResult = lngCurIdx & ": " & Left(strValue, lngValueLen)
       'List1.AddItem strResult
       Debug.Print strResult
    End If
    
    Loop While lngResult = ERROR_SUCCESS
    Call RegCloseKey(lngKeyHandle)
End Sub
                   
'reads the value for the registry key i_RegKey
'if the key cannot be found, the return value is ""
Function RegKeyRead(i_RegKey As String) As String
Dim myWS As Object

    On Error Resume Next
    'access Windows scripting
    Set myWS = CreateObject("WScript.Shell")
    'read key from registry
    RegKeyRead = myWS.RegRead(i_RegKey)
End Function

'returns True if the registry key i_RegKey was found
'and False if not
Function RegKeyExists(i_RegKey As String) As Boolean
Dim myWS As Object

    On Error GoTo ErrorHandler
    'access Windows scripting
    Set myWS = CreateObject("WScript.Shell")
    'try to read the registry key
    myWS.RegRead i_RegKey
    'key was found
    RegKeyExists = True
    Exit Function
  
ErrorHandler:
    'key was not found
    RegKeyExists = False
End Function

Sub run_me()
    ' http://vba-corner.livejournal.com/3054.html
    Debug.Print RegKeyExists("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings")
    ' http://support.microsoft.com/kb/178755
    reg_keys_list
End Sub