Lecture de base de registre

Slt

J'ai besoin d'obtenir une valeur contenu dans Default Mail
Account
dans la
clé :HKEY_CURRENT_USER\Software\Microsoft\Office\Outlook\OM
I Account Manager
dans le registre.

J utilise :
CompteMessagerie$ = GetKeyValue
(HKEY_CURRENT_USER, "Software\Microsoft\Office\Outlook\OMI
Account Manager\Default Mail Account", "")
Mais voila je n'arrive pas a obtenir 00000001 contenu dans
Default Mail Account.
Pourquoi ?


dans le module j'ai :
***********************************************************
***********
***********************************************************
***********
' Ce module lit et écrit les clés de la base de registres.
Contrairement
' aux méthodes d'accès à la base de regitres interne de
VB, il peut lire
' et écrire toute les clés du registre avec des valeurs de
type chaîne.

'Option Explicit
'-
--
'- Déclarations des API de base de registres
'-
--
Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As
Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32"
Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal
lpSubKey As String, ByVal reserved As Long, ByVal lpClass
As String, ByVal dwOptions As Long, ByVal samDesired As
Long, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES,
ByRef phkResult As Long, ByRef lpdwDisposition As Long) As
Long
Declare Function RegOpenKeyEx Lib "advapi32"
Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey
As String, ByVal ulOptions As Long, ByVal samDesired As
Long, ByRef phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32"
Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal
lpValueName As String, ByVal lpReserved As Long, ByRef
lpType As Long, ByVal lpData As String, ByRef lpcbData As
Long) As Long
Declare Function RegSetValueEx Lib "advapi32"
Alias "RegSetValueExA" (ByVal hKey As Long, ByVal
lpValueName As String, ByVal reserved As Long, ByVal
dwType As Long, ByVal lpData As String, ByVal cbData As
Long) As Long
'
'-
--
'- Constantes des API de base de registres
'-
--
' Types de données de base de registres
Global Const REG_SZ = 1 '
chaîne Unicode terminée par nul
Global Const REG_EXPAND_SZ = 2 '
chaîne Unicode terminée par nul
Global Const REG_DWORD = 4 '
nombre 32-bit
' Valeurs de type de création
Global Const REG_OPTION_NON_VOLATILE = 0 '
clé préservée lorsque le système
' est
redémarré

' Options de sécurité de clé de base de registres
Global Const READ_CONTROL = &H20000
Global Const KEY_QUERY_VALUE = &H1
Global Const KEY_SET_VALUE = &H2
Global Const KEY_CREATE_SUB_KEY = &H4
Global Const KEY_ENUMERATE_SUB_KEYS = &H8
Global Const KEY_NOTIFY = &H10
Global Const KEY_CREATE_LINK = &H20
Global Const KEY_READ = KEY_QUERY_VALUE +
KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Global Const KEY_WRITE = KEY_SET_VALUE +
KEY_CREATE_SUB_KEY + READ_CONTROL
Global Const KEY_EXECUTE = KEY_READ
Global Const KEY_ALL_ACCESS = KEY_QUERY_VALUE +
KEY_SET_VALUE + KEY_CREATE_SUB_KEY +
KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + KEY_CREATE_LINK +
READ_CONTROL

' Types de clé Racine de la base de registres
Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003
Global Const HKEY_PERFORMANCE_DATA = &H80000004

' Valeur renvoyée
Global Const ERROR_NONE = 0
Global Const ERROR_BADKEY = 2
Global Const ERROR_ACCESS_DENIED = 8
Global Const ERROR_SUCCESS = 0

'-
--
'- Type Security_Attributes de la base de registres
'-
--
Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type


'-

'Exemple d'utilisation - Debug.Print GetKeyValue
(HKEY_CLASSES_ROOT, "COMCTL.ListviewCtrl.1\CLSID", "")
'-

Function GetKeyValue(KeyRoot As Long, KeyName As String,
SubKeyRef As String) As String
Dim i As Long ' Compteur de boucle
Dim rc As Long ' Code renvoyé
Dim hKey As Long ' Descripteur de clé
de base de registres ouverte
Dim hDepth As
Long '
Dim sKeyVal As String
Dim lKeyValType As Long ' Type de données
d'une clé de base de registres
Dim tmpVal As String ' Stockage temporaire
d'une valeur de clé de base de registres
Dim KeyValSize As Long ' Taille d'une
variable clé de base de registres


' Ouvre RegKey sous KeyRoot {HKEY_LOCAL_MACHINE}
'

rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS,
hKey) ' Ouvre la clé de base de registres

If (rc <> ERROR_SUCCESS) Then GoTo
GetKeyError ' Gestion des erreurs

tmpVal = String$(1024,
0) ' Alloue de l'espace
pour la variable
KeyValSize =
1024 ' Définit
la taille de la variable

'

' Récupère une valeur de clé de base de registres
'

rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
lKeyValType, tmpVal,
KeyValSize) ' Lit/Crée une valeur de clé

If (rc <> ERROR_SUCCESS) Then GoTo
GetKeyError ' Gestion des erreurs

tmpVal = Left$(tmpVal, InStr(tmpVal, Chr(0)) - 1)

'

' Détermine le type de valeur de clé pour la
conversion
'

Select Case
lKeyValType '
Recherche des types de données
Case REG_SZ,
REG_EXPAND_SZ ' Type de
données String de clé de base de registres
sKeyVal =
tmpVal ' Copie la
valeur String
Case
REG_DWORD '
Type de données Double Word de clé de base de registres
For i = Len(tmpVal) To 1 Step -
1 ' Convertit chaque bit
sKeyVal = sKeyVal + Hex(Asc(Mid(tmpVal, i,
1))) ' Génère la valeur car. par car.
Next
sKeyVal = Format$("&h" +
sKeyVal) ' Convertit le type Double
Word en String
End Select

GetKeyValue =
sKeyVal ' Valeur
renvoyée
rc = RegCloseKey
(hKey) ' Ferme la clé
de base de registres
Exit
Function '
Quitte

GetKeyError:
' Nettoyage après apparition d'une erreur
GetKeyValue =
vbNullString ' Affecte
une chaîne vide à la valeur renvoyée
rc = RegCloseKey
(hKey) ' Ferme la clé
de base de registres
End Function
***********************************************************
***********
***********************************************************
***********
Nom de la
clé :HKEY_CURRENT_USER\Software\Microsoft\Office\Outlook\OM
I Account Manager
Nom de la classe : <Sans classe>
Heure de dernière écriture : 11/02/2004 - 16:01
Valeur 0
Nom : Account Name
Type : REG_DWORD
Données : 0x5

Valeur 1
Nom : Default Mail Account
Type : REG_SZ
Données : 00000001

Valeur 2
Nom : Server ID
Type : REG_DWORD
Données : 0x1