Option Explicit
'__________________________________________________________________
'служит процедуре Считываем_реестр_папку_HKEY_CURRENT_USER_Software
Private Const MAX_PATH As Long =  260 
 
Private Const HKEY_CLASSES_ROOT As Long = &H80000000
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const HKEY_USERS As Long = &H80000003
Private Const HKEY_PERFORMANCE_DATA As Long = &H80000004
Private Const HKEY_CURRENT_CONFIG As Long = &H80000005
 
Private Const KEY_READ As Long = &H20019
 
Private Const ERROR_SUCCESS As Long =  0 
 
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
 
Private Declare Function RegEnumKeyEx Lib "advapi32" 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 RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
    ByVal hKey As Long, _
    ByVal pSubKey As String, _
    ByVal ulOptions As Long, _
    ByVal samDesired As Long, phkResult As Long) As Long
'_________________________________________________________________________________
'конец блока служащего процедуре Считываем_реестр_папку_HKEY_CURRENT_USER_Software
    
 Sub Считываем_реестр_папку_HKEY_CURRENT_USER_Software()
 
    Dim dwIndex As Long
    Dim sTypeName As String
    Dim Все_программы As String
    Dim Программа As String
    Dim sSubkey As String * MAX_PATH
    Dim sClass As String * MAX_PATH
    Dim ft As FILETIME
    Dim lSubkey As Long
    Dim hKey As Long
    
    If RegOpenKeyEx(HKEY_CURRENT_USER, "Software",  0 , KEY_READ, hKey) <> ERROR_SUCCESS Then MsgBox$ "В реестре не имеется папки HKEY_CURRENT_USER, Software": Exit Sub
    
    lSubkey = MAX_PATH
    Все_программы = ""
    Do While RegEnumKeyEx(hKey, _
                          dwIndex, _
                          sSubkey, _
                          lSubkey, _
                           0 , sClass, _
                          MAX_PATH, ft) = ERROR_SUCCESS
                          Программа = Left(sSubkey, lSubkey)
        Debug.Print Программа
        lSubkey = MAX_PATH
        dwIndex = dwIndex +  1 
        Все_программы = Все_программы & Программа & Chr( 13 )
    Loop
MsgBox$ "Закончено, в реестре, в папке HKEY_CURRENT_USER, Software находятся папки:" & Chr( 13 ) & Все_программы & Chr( 13 ) & "Всего: " & dwIndex & " шт."
'Ворд находится в папке HKEY_CURRENT_USER, Software, Микрософт, Офис, Ворд

End Sub