Fritz
Ingen enkel sak. Men det går.
Lim dette inn i en modul. Bruk GetString på tekstverdier og GetDword på
tall/hex-verdier:
'top of module:******************************
Option Explicit
Public Const HKEY_CURRENT_USER = &H80000001
Public Const ERROR_SUCCESS = 0&
Declare Function RegOpenKey Lib "advapi32.dll" Alias _
"RegOpenKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, _
phkResult As Long) As Long
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 Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
Public Const REG_SZ = 1 ' Unicode nul terminated String
Public Const REG_DWORD = 4 ' 32-bit number
'testkode -endre banen til Excel 8 om nødvendig:
Sub PromptR1C1()
If getdword(HKEY_CURRENT_USER, _
"Software\Microsoft\Office\9.0\Excel\Options", "Options") = 343 Then
MsgBox "Excel is set to A1 style"
Else
MsgBox "Excel is set to R1C1 style"
End If
End Sub
Public Function GetString(Hkey As Long, _
strPath As String, strValue As String)
'EXAMPLE:
'
'text1.text = getstring(HKEY_CURRENT_USE
' R, "Software\VBW\Registry", "String")
Dim r, lValueType
Dim keyhand As Long
Dim datatype As Long
Dim lResult As Long
Dim strBuf As String
Dim lDataBufSize As Long
Dim intZeroPos As Integer
r = RegOpenKey(Hkey, strPath, keyhand)
lResult = RegQueryValueEx(keyhand, strValue, 0&, _
lValueType, ByVal 0&, lDataBufSize)
If lValueType = REG_SZ Then
strBuf = String(lDataBufSize, " ")
lResult = RegQueryValueEx(keyhand, strValue, _
0&, 0&, ByVal strBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
intZeroPos = InStr(strBuf, Chr$(0))
If intZeroPos > 0 Then
GetString = Left$(strBuf, intZeroPos - 1)
Else
GetString = strBuf
End If
End If
End If
End Function
Function getdword(ByVal Hkey As Long, ByVal strPath As String, ByVal
strValueName As String) As Long
'EXAMPLE:
'
'text1.text = getdword(HKEY_CURRENT_USER
' , "Software\VBW\Registry", "Dword")
'
Dim lResult As Long
Dim lValueType As Long
Dim lBuf As Long
Dim lDataBufSize As Long
Dim r As Long
Dim keyhand As Long
r = RegOpenKey(Hkey, strPath, keyhand)
' Get length/data type
lDataBufSize = 4
lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf,
lDataBufSize)
If lResult = ERROR_SUCCESS Then
If lValueType = REG_DWORD Then
getdword = lBuf
End If
End If
r = RegCloseKey(keyhand)
End Function
'*********************
Koden er fra
http://www.vbfrance.com/article.asp?Val=215
HTH. Beste hilsen Harald
Fritz Holtze <holtze@post.tele.dk> skrev i
news:984tm3$4fi$1@news.inet.tele.dk...
> Hej
> Er der nogen der ved om det er muligt - og hvordan, man læser data i
> Registreringsdatabasen med Office97's VBA.
>
> Proceduren "GetSetting" giver tilsyneladende kun VBA mulighed for at læse
et
> bestemt sted i Registreringsdatabasen, hvordan læses der i de øvrige
> "mapper" i registreringsdatabasen?
>
> Håber at nogen i gruppen kender svaret.
>
> Med venlig hilsen
>
> Fritz Holtze
>
> holtze@post.tele.dk
>
>
>
>
>