Attribute VB_Name = "Module1"
Option Explicit
'
Private lngRow As Long
Private lngCol As Long
'
'egistry)
Private Const KEY_QUERY_VALUE           As Long = &H1
Private Const KEY_ENUMERATE_SUB_KEYS    As Long = &H8
Private Const KEY_NOTIFY                As Long = &H10
Private Const KEY_CREATE_SUB_KEY        As Long = &H4
Private Const ERROR_SUCCESS = 0&
'(型)
Private Enum hKeyConstants
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
    HKEY_PERFORMANCE_DATA = &H80000004
    HKEY_CURRENT_CONFIG = &H80000005
    HKEY_DYN_DATA = &H80000006
End Enum
'(DWORD型タイプ)
Private Enum RegTypeConstants
    REG_SZ = (1)
    REG_DWORD = (4)
    REG_DWORD_LITTLE_ENDIAN = (4)
End Enum
Private Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type
'(KEY)
Private Const KEY_READ As Long = KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
'(API)
Private Declare Function RegOpenKeyEx Lib "ADVAPI32" Alias "RegOpenKeyExA" ( _
    ByVal hKey&, _
    ByVal lpSubKey$, _
    ByVal ulOptions&, _
    ByVal samDesired&, _
    phkResult&) As Long
'サブキー列挙
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" ( _
    ByVal hKey As Long, _
    ByVal dwIndex As Long, _
    ByVal lpName As String, _
    lpcbName As Long, _
    ByVal lpReserved As Long, _
    ByVal lpClass As String, _
    lpcbClass As Long, _
    lpftLastWriteTime As FILETIME) As Long
Private Declare Function RegQueryValueEx Lib "ADVAPI32" Alias "RegQueryValueExA" ( _
    ByVal hKey As Long, _
    ByVal lpValueName As String, _
    ByVal lpReserved As Long, _
    lpType As Long, _
    lpData As Any, _
    lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "ADVAPI32" (ByVal hKey&) As Long
'

Sub レジストリRead処理実行()
    Err.Clear
    On Error Resume Next
    On Error GoTo Err_処理
        
    Dim lnghInKey As hKeyConstants
    Dim strSubKey As String
    Dim lngType As RegTypeConstants
    Dim varDefault As Variant
    Dim strDisplayName As String
    
    '検索初期値
    lngRow = 0
    lngCol = 0
    lnghInKey = HKEY_LOCAL_MACHINE
    'strSubKey = "Software\Microsoft\Windows\CurrentVersion\Uninstall"
    strSubKey = "SOFTWARE\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall"
    lngType = REG_SZ
    varDefault = Null
    strDisplayName = "DisplayName"
    
    '検索開始
    Dim varRetVal           As Variant
    Dim lnghKey             As Long
    Dim lngResult           As Long

    Dim lngNm As Long
    Dim strName As String
    Dim lngName As Long
    Dim lngRes As Long
    Dim strCls As String
    Dim lngCls As Long
    Dim File As FILETIME

    Dim lnghSubKey          As Long
    Dim lngBuffer           As Long
    Dim strBuffer           As String
    Dim varRetDisplayName   As Variant
    
    '初期値
    lngNm = 0
    lngRes = 0
    strCls = vbNullString
    lngCls = 0
    'バッファ
    strName = String(250, Chr(0))
    lngName = Len(strName)
    'キーオープンハンドル取得
    lngResult = RegOpenKeyEx _
               (lnghInKey, _
                strSubKey, _
                0, _
                KEY_READ, _
                lnghKey)
    Do
       'サブキー
       lngResult = RegEnumKeyEx(lnghKey, lngNm, strName, lngName, lngRes, strCls, lngCls, File)
       'ループ抜け
       If lngResult <> ERROR_SUCCESS Then
         Exit Do
       End If
       '名前の編集
       strName = Replace(strName, Chr(0), vbNullString)
       
        '値の読み込み。
        If Trim(strName) <> "" Then
            '値のOpen
            varRetVal = vbNullString
            lngResult = RegOpenKeyEx(lnghInKey, _
                        strSubKey & "\" & strName, _
                        0, _
                        KEY_READ, _
                        lnghSubKey)
            If lngResult = ERROR_SUCCESS Then
                'バッファ
                varRetDisplayName = ""
                strBuffer = String(256, vbNullChar)
                lngResult = RegQueryValueEx(lnghSubKey, _
                            strDisplayName, _
                            0, _
                            REG_SZ, _
                            ByVal strBuffer, _
                            Len(strBuffer))
                If lngResult = ERROR_SUCCESS Then
                    varRetDisplayName = _
                    Left$(strBuffer, InStr(strBuffer, vbNullChar) - 1)
                End If
                'サブ解放
                Call RegCloseKey(lnghSubKey)
            End If
        End If
        '
        lngNm = lngNm + 1
        lngRow = lngRow + 1
        Cells(lngRow, lngCol + 1) = strName
        Cells(lngRow, lngCol + 2) = varRetDisplayName
        '初期化
        strName = String(250, Chr(0))
        lngName = Len(strName)
    Loop
    'キー解放
    Call RegCloseKey(lnghKey)

Exit Sub
'**
Err_処理:
  MsgBox "Error ( " & Err.Number & " " & Err.Description & " )"
'***
End Sub