[VBA] úprava registrů

[Jochynator]

VBA neumí zapisovat a číst do/z libovolného registru, potřebujes k tomu API.
V případe, že bys chtěl jen načítat/ukládat nastavení tvých Excelovských aplikací můžeš použít funkce VBA GetSettings a SaveSettings ( http://j-walk.com/ss/excel/tips/tip60.htm ), ale s těma se dostaneš jen na jeden klič:

HKEY_CURRENT_USER\Software\VB and VBA Program Settings

Tady jsou ty API fce:

' 32-bit declarations 
Private Declare Function RegOpenKeyA Lib "ADVAPI32.DLL" _ 
    (ByVal hKey As Long, ByVal sSubKey As String, _ 
    ByRef hkeyResult As Long) As Long 

Private Declare Function RegCloseKey Lib "ADVAPI32.DLL" _ 
    (ByVal hKey As Long) As Long 

Private Declare Function RegSetValueExA Lib "ADVAPI32.DLL" _ 
    (ByVal hKey As Long, ByVal sValueName As String, _ 
    ByVal dwReserved As Long, ByVal dwType As Long, _ 
    ByVal sValue As String, ByVal dwSize As Long) As Long 

Private Declare Function RegCreateKeyA Lib "ADVAPI32.DLL" _ 
    (ByVal hKey As Long, ByVal sSubKey As String, _ 
    ByRef hkeyResult As Long) As Long 

Private Declare Function RegQueryValueExA Lib "ADVAPI32.DLL" _ 
    (ByVal hKey As Long, ByVal sValueName As String, _ 
    ByVal dwReserved As Long, ByRef lValueType As Long, _ 
    ByVal sValue As String, ByRef lResultLen As Long) As Long

A pro ně vytvořené obálkové fce:
ČTENÍ:

Private Function GetRegistry(Key, Path, ByVal ValueName As String) 
'  Reads a value from the Windows Registry 

    Dim hKey As Long 
    Dim lValueType As Long 
    Dim sResult As String 
    Dim lResultLen As Long 
    Dim ResultLen As Long 
    Dim x, TheKey As Long 

    TheKey = -99 
    Select Case UCase(Key) 
        Case "HKEY_CLASSES_ROOT": TheKey = &H80000000 
        Case "HKEY_CURRENT_USER": TheKey = &H80000001 
        Case "HKEY_LOCAL_MACHINE": TheKey = &H80000002 
        Case "HKEY_USERS": TheKey = &H80000003 
        Case "HKEY_CURRENT_CONFIG": TheKey = &H80000004 
        Case "HKEY_DYN_DATA": TheKey = &H80000005 
    End Select 
    
'   Exit if key is not found 
    If TheKey = -99 Then 
        GetRegistry = "Not Found" 
        Exit Function 
    End If 

    If RegOpenKeyA&#40;TheKey, Path, hKey&#41; <> 0 Then _ 
        x = RegCreateKeyA&#40;TheKey, Path, hKey&#41; 
    
    sResult = Space&#40;100&#41; 
    lResultLen = 100 
    
    x = RegQueryValueExA&#40;hKey, ValueName, 0, lValueType, _ 
    sResult, lResultLen&#41; 
        
    Select Case x 
        Case 0&#58; GetRegistry = Left&#40;sResult, lResultLen - 1&#41; 
        Case Else&#58; GetRegistry = "Not Found" 
    End Select 
    
    RegCloseKey hKey 
End Function

ZÁPIS:

Private Function WriteRegistry(ByVal Key As String, _ 
    ByVal Path As String, ByVal entry As String, _ 
    ByVal value As String) 
    
    Dim hKey As Long 
    Dim lValueType As Long 
    Dim sResult As String 
    Dim lResultLen As Long 
    Dim TheKey As Long 
    Dim x 
    
    
    TheKey = -99 
    Select Case UCase(Key) 
        Case "HKEY_CLASSES_ROOT": TheKey = &H80000000 
        Case "HKEY_CURRENT_USER": TheKey = &H80000001 
        Case "HKEY_LOCAL_MACHINE": TheKey = &H80000002 
        Case "HKEY_USERS": TheKey = &H80000003 
        Case "HKEY_CURRENT_CONFIG": TheKey = &H80000004 
        Case "HKEY_DYN_DATA": TheKey = &H80000005 
    End Select 
    
'   Exit if key is not found 
    If TheKey = -99 Then 
        WriteRegistry = False 
        Exit Function 
    End If 

'   Make sure  key exists 
    If RegOpenKeyA&#40;TheKey, Path, hKey&#41; <> 0 Then 
        x = RegCreateKeyA&#40;TheKey, Path, hKey&#41; 
    End If 

    x = RegSetValueExA&#40;hKey, entry, 0, 1, value, Len&#40;value&#41; + 1&#41; 
    If x = 0 Then WriteRegistry = True Else WriteRegistry = False 
End Function