[VBA] Modifier une valeur DWORD de la base de registre

C'est bon... j'ai réussi à trouver un exemple sur le Net... pour info :


Option Explicit

Public Const HKEY_CLASSES_ROOT As Long = &H80000000
Public Const HKEY_CURRENT_USER As Long = &H80000001
Public Const HKEY_LOCAL_MACHINE As Long = &H80000002
Public Const HKEY_USERS As Long = &H80000003

Public Const ERROR_SUCCESS As Long = 0
Public Const ERROR_FILE_NOT_FOUND As Long = 2
Public Const ERROR_INVALID_HANDLE As Long = 6
Public Const ERROR_NO_ACCESS As Long = 998

Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4

Public Declare Function RegOpenKey Lib "ADVAPI32" Alias "RegOpenKeyA" _
(ByVal hkeyOpen As Long, ByVal szSubKey As String, ByRef hkeyResult As
Long) As Long
Public Declare Function RegCreateKey Lib "ADVAPI32" Alias "RegCreateKeyA" _
(ByVal hkeyOpen As Long, ByVal szSubKey As String, ByRef hkeyResult As
Long) As Long
Public Declare Function RegQuerySzValue Lib "ADVAPI32" Alias
"RegQueryValueExA" _
(ByVal hkey As Long, ByVal szValueName As String, ByVal lReserved As
Long, ByRef lType As Long, _
ByVal sValue As String, ByRef lcbData As Long) As Long
Public Declare Function RegQueryDwordValue Lib "ADVAPI32" Alias
"RegQueryValueExA" _
(ByVal hkey As Long, ByVal szValueName As String, ByVal lReserved As
Long, ByRef lType As Long, _
ByRef lValue As Long, ByRef lcbData As Long) As Long
Public Declare Function RegQueryNullValue Lib "ADVAPI32" Alias
"RegQueryValueExA" _
(ByVal hkey As Long, ByVal szValueName As String, ByVal lReserved As
Long, ByRef lType As Long, _
ByVal vNull As Any, ByRef lcbData As Long) As Long
Public Declare Function RegCloseKey Lib "ADVAPI32" (ByVal hkey As Long) As
Long
Public Declare Function RegSetSzValue Lib "ADVAPI32" Alias "RegSetValueExA"
(ByVal hkey As Long, ByVal szValueName As String, ByVal dwReserved As Long,
ByVal lType As Long, _
ByVal sValue As String, ByVal lcbData As Long) As Long
Public Declare Function RegSetDwordValue Lib "ADVAPI32" Alias
"RegSetValueExA" _
(ByVal hkey As Long, ByVal szValueName As String, ByVal dwReserved As
Long, ByVal lType As Long, _
ByRef lValue As Long, ByVal lcbData As Long) As Long

'************ Examples
Sub RegistryExamples()
Dim v As Variant 'Result
'HKEY_CLASSES_ROOT =0
'HKEY_CURRENT_USER =1
'HKEY_LOCAL_MACHINE =2
'HKEY_USERS =3
'To read a Value from Registry:
'Function GetRegValue(hkeyOpen&,szSection$, szKey$) As Variant
v = GetRegValue(1, "SoftwareMicrosoftVBAExcel", "BreakOnAllErrors")
If VarType(v) = vbError Then MsgBox "Clé non valide" Else MsgBox v

'To modify a Registry Value:
'Function SetRegValue(hkeyOpen&,szSection$, szKey$, Value As Variant) As
Variant
v = SetRegValue(1, "SoftwareMicrosoftVBAExcel", "BreakOnAllErrors",
0)
If VarType(v) = vbError Then MsgBox "Clé non valide" Else MsgBox v
End Sub


'************ Write a Registry Value
Function SetRegValue(hkeyOpen, szSection, szKey, Value As Variant) As
Variant
Dim hkey As Long, lResult As Long, lcbValue As Long, szValue As String,
lValue As Long, hNum As Long, lType As Long
'hkey = &H80000000 + hkeyOpen
hkey = hkeyOpen

' Open key ; create it if it doesn'nt exist
lResult = RegCreateKey(hkey, szSection, hNum)
If lResult <> ERROR_SUCCESS Then
SetRegValue = CVErr(xlErrNA)
Exit Function
End If

' Set Value Type to REG_SZ or REG_DWORD
If TypeName(Value) = "String" Then
lType = REG_SZ
Value = Value & Chr(0)
lcbValue = Len(Value)
lResult = RegSetSzValue(hNum, szKey, 0&, lType, CStr(Value),
lcbValue)
ElseIf TypeName(Value) = "Integer" Or TypeName(Value) = "Long" _
Or TypeName(Value) = "Double" Then
lType = REG_DWORD
lcbValue = 4
lValue = CLng(Value)
lResult = RegSetDwordValue(hNum, szKey, 0&, lType, lValue, lcbValue)
Else
Value = CStr(Value)
lType = REG_SZ
Value = Value & Chr(10)
lcbValue = Len(Value)
lResult = RegSetSzValue(hNum, szKey, 0&, lType, CStr(Value),
lcbValue)
End If

If lResult <> ERROR_SUCCESS Then
SetRegValue = CVErr(xlErrNA)
Exit Function
End If

' Close Key
lResult = RegCloseKey(hNum)
If lResult <> ERROR_SUCCESS Then
SetRegValue = False
Exit Function
Else
SetRegValue = True
End If
End Function

sub exemple
dim ret as long
ret = SetRegValue(HKEY_CURRENT_USER,
"SOFTWAREMicrosoftWindowsCurrentVersionPoliciesExplorer",
"NoDriveTypeAutoRun", 255)
end if

On peut éviter les API de manipulation du registre (qui ne se distinguent pas
par leur simplicité) en utilisant le Windows Scripting Host Object Model.
Quelques procs de Jim Rech pour te faire une idée :

'======================== Sub RegWrite()
Dim wsh As Object
Set wsh = CreateObject("WScript.Shell")
wsh.RegWrite "HKCUSoftwareBogus", "This is a default value"
wsh.RegWrite "HKCUSoftwareBogusMyString", "A string value"
wsh.RegWrite "HKCUSoftwareBogusMyNumString", 12345
wsh.RegWrite "HKCUSoftwareBogusMyDwordValue", 12346, "REG_DWORD"
End Sub

Sub RegRead()
Dim wsh As Object
Set wsh = CreateObject("WScript.Shell")
Debug.Print wsh.RegRead("HKCUSoftwareBogus")
Debug.Print wsh.RegRead("HKCUSoftwareBogusMyString")
Debug.Print wsh.RegRead("HKCUSoftwareBogusMyNumString")
Debug.Print wsh.RegRead("HKCUSoftwareBogusMyDwordValue")
End Sub

Sub RegDelete()
Dim wsh As Object
Set wsh = CreateObject("WScript.Shell")
'This deletes entire branch
wsh.RegDelete "HKCUSoftwareBogus"
End Sub


'========================
FS
---
Frédéric Sigonneau
http://frederic.sigonneau.free.fr

HD a écrit :

Bonjour,

Je voudrais pouvoir modifier une donnée DWORD de la base de registre...
Auriez vous un exemple à me fournir ?

Merci d'avance pour votre aide