AW: kompletten Registry-Key in Arbeitsblatt einlesen
09.11.2006 18:31:36
Fritz
Hallo Andreas,
hier die Funktion.
Den Namen des Schlüssels musst Du noch anpassen
Gruß
Fritz
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
Private Declare
Function RegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal _
lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, lpData As Any, lpcbData As Any) As Long
Private Declare
Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Const ERROR_NO_MORE_ITEMS = 259&
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_DYN_DATA = &H80000006
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 = KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS _
Or KEY_NOTIFY
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE Or _
KEY_SET_VALUE Or _
KEY_CREATE_SUB_KEY Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY Or _
KEY_CREATE_LINK
Const ERROR_SUCCESS = 0&
Const REG_NONE = 0
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_DWORD_LITTLE_ENDIAN = 4
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_LINK = 6
Const REG_MULTI_SZ = 7
Const REG_OPTION_NON_VOLATILE = &H0
Dim Cnt As Long, sName As String, sData As String, Ret As Long, RetData As Long
Const BUFFER_SIZE As Long = 255
Dim hKey&, s$, l&, dwType&, Lng&, buffer$
Dim Namen() As String
Sub ReadReg()
Dim I&, result&
Ret = BUFFER_SIZE
If RegOpenKey(HKEY_CURRENT_USER, "Software\Microsoft\Office\11.0\Excel\Options", hKey) = 0 Then
'Create a buffer
sName = Space(BUFFER_SIZE)
'Enumerate the keys
result = (GetFields(HKEY_CURRENT_USER, "Software\Microsoft\Office\11.0\Excel\Options"))
RegCloseKey hKey
End If
End Sub
Function GetFields(RegRoot&, SubKey$)
Dim Feld
Dim I&
Dim Fieldname$
Dim result&
Cnt = 0
ReDim Namen(0)
While RegEnumValue(hKey, Cnt, sName, Ret, 0, ByVal 0&, ByVal sData, RetData) <> ERROR_NO_MORE_ITEMS
If RetData > 0 Then
Namen(Cnt) = Left(sName, Ret)
ReDim Preserve Namen(UBound(Namen) + 1)
End If
Cnt = Cnt + 1
sName = Space(BUFFER_SIZE)
sData = Space(BUFFER_SIZE)
Ret = BUFFER_SIZE
RetData = BUFFER_SIZE
Wend
For I = 0 To UBound(Namen)
Cells(I + 1, 1) = Namen(I) & " = " & RegValueGet(HKEY_CURRENT_USER, SubKey, Namen(I), Feld)
Next
End Function
Function RegValueGet(Root&, Key$, Field$, Value As Variant)
Dim result&
buffer = ""
'Wert aus einem Feld der Registry auslesen
result = RegOpenKeyEx(Root, Key, 0, KEY_READ, hKey)
If result = ERROR_SUCCESS Then
result = RegQueryValueEx(hKey, Field, 0&, dwType, ByVal 0&, l)
If result = ERROR_SUCCESS Then
Select Case dwType
Case REG_SZ
buffer = Space$(l + 1)
result = RegQueryValueEx(hKey, Field, 0&, _
dwType, ByVal buffer, l)
If result = ERROR_SUCCESS Then Value = buffer
Case REG_EXPAND_SZ
buffer = Space$(l + 1)
result = RegQueryValueEx(hKey, Field, 0&, _
dwType, ByVal buffer, l)
If result = ERROR_SUCCESS Then Value = buffer
Case REG_DWORD
result = RegQueryValueEx(hKey, Field, 0&, dwType, Lng, l)
If result = ERROR_SUCCESS Then Value = Lng
End Select
End If
End If
If result = ERROR_SUCCESS Then result = RegCloseKey(hKey)
RegValueGet = Value
End Function