Option Explicit

Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
     ByVal hKey As Long, _
     ByVal lpValueName As String, _
     ByVal lpReserved As Long, _
     ByRef lpType As Long, _
     ByRef lpData As Any, _
     ByRef 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, _
     ByRef phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
     ByVal hKey As Long) As Long


Private Const READ_CONTROL As Long = &H20000
Private Const STANDARD_RIGHTS_READ As Long = (READ_CONTROL)
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 SYNCHRONIZE As Long = &H100000

Private Const HKEY_CURRENT_USER As Long = &H80000001


Private Const KEY_READ As Long = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const REG_SZ As Long = 1
Private Const REG_DWORD As Long = 4

' Для проверки.
Public Sub Main()
    Dim objShell As Object
    Dim lKey As Long
    Dim sMsg As String
    
    Set objShell = VBA.CreateObject("WScript.Shell")
    
    objShell.RegWrite "HKEY_CURRENT_USER\Software\ACME\FortuneTeller\", 555, "REG_DWORD"
    objShell.RegWrite "HKEY_CURRENT_USER\Software\ACME\FortuneTeller\MindReader", "Goocher!", "REG_SZ"
     
    lKey = GetDword("Software\ACME\FortuneTeller\", "")
    sMsg = GetString("Software\ACME\FortuneTeller\", "MindReader")
    MsgBox sMsg & vbNewLine & lKey
    
    
    lKey = objShell.RegRead("HKCU\Software\ACME\FortuneTeller\")
    sMsg = objShell.RegRead("HKCU\Software\ACME\FortuneTeller\MindReader")
    MsgBox sMsg & vbNewLine & lKey 
    
    objShell.RegDelete "HKEY_CURRENT_USER\Software\ACME\FortuneTeller\MindReader"
    objShell.RegDelete "HKEY_CURRENT_USER\Software\ACME\FortuneTeller\"
    objShell.RegDelete "HKEY_CURRENT_USER\Software\ACME\"
End Sub



'1. Нафик всё по-ссылке передавать?
'2. Нафик передавать hKey, если ты его там затираешь открываемым и закрываешь?
'3. rtn - не объявлена.
Function GetDword(ByVal strPath As String, ByVal strValue As String) As Long
    'А почему strData типа long? Врагов запутать хочешь? :-)
    Dim dwData As Long
    Dim hKey As Long
    Dim rtn As Long
        
    ' Ошибку не отлавливаем по идейным соображениям или по лени?
    
    rtn = RegOpenKeyEx(HKEY_CURRENT_USER, strPath, 0&, KEY_READ, hKey)
    If rtn <> 0& Then Err.Raise &H80070000 Or rtn
    
    rtn = RegQueryValueEx(hKey, strValue, 0&, REG_DWORD, dwData, 4&)
    If rtn <> 0& Then Err.Raise &H80070000 Or rtn
    
    rtn = RegCloseKey(hKey)
    If rtn <> 0& Then Err.Raise &H80070000 Or rtn
    
    GetDword = dwData
Exit Function
catch:
    If hKey <> 0& Then
        RegCloseKey hKey
    End If
    
    ' Это на скорую руку сделано. Надо делать НЕтак!!!
    ' Нужно в первую очередь в переменную сохранять данные об ошибке и из неё брать их потом.
    With Err
        .Raise .Number, .Source, .Description, .HelpFile, .HelpContext
    End With
End Function

'1. Нафик всё по-ссылке передавать?
' и т.д.
Function GetString(ByVal strPath As String, ByVal strValue As String) As String
    Dim hKey As Long
    Dim rtn As Long
    Dim strData As String
    Dim dwLen As Long
    Dim i As Long

    rtn = RegOpenKeyEx(HKEY_CURRENT_USER, strPath, 0&, KEY_READ, hKey)
    If rtn <> 0& Then Err.Raise &H80070000 Or rtn
    
    rtn = RegQueryValueEx(hKey, strValue, 0&, REG_SZ, ByVal 0&, dwLen)
    If rtn <> 0& Then Err.Raise &H80070000 Or rtn
        
    strData = String$(dwLen - 1, vbNullChar)
    
    rtn = RegQueryValueEx(hKey, strValue, 0&, REG_SZ, ByVal strData, dwLen)
    If rtn <> 0& Then Err.Raise &H80070000 Or rtn
          
    rtn = RegCloseKey(hKey)
    If rtn <> 0& Then Err.Raise &H80070000 Or rtn
    
    ' Зачем? А вдруг пользователь специально пробелы ввёл, а ты ему их обрезаешь.
    strData = Trim(strData)
    GetString = strData
Exit Function
catch:
    If hKey <> 0& Then
        RegCloseKey hKey
    End If
        
    ' Это на скорую руку сделано. Надо делать НЕтак!!!
    ' Нужно в первую очередь в переменную сохранять данные об ошибке и из неё брать их потом.
    With Err
        .Raise .Number, .Source, .Description, .HelpFile, .HelpContext
    End With
End Function