Trouver l'adresse email par défaut d'un user (outlook)

colichon2000 Messages postés 4 Date d'inscription jeudi 11 décembre 2003 Statut Membre Dernière intervention 14 décembre 2003 - 11 déc. 2003 à 20:37
colichon2000 Messages postés 4 Date d'inscription jeudi 11 décembre 2003 Statut Membre Dernière intervention 14 décembre 2003 - 14 déc. 2003 à 15:29
Bonjour,

J'aimerais faire un programme VB qui fournit l'adresse email par defaut du user qui travaille sur le PC.
Ce programme VB irait donc lire l'adresse par défaut du user dans outlook ou outlook express.

Merci d'avance

4 réponses

cs_Jack Messages postés 14006 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 79
12 déc. 2003 à 16:34
Salut colichon2000

J'utilise ces quelques lignes en recherche dans la BdR :
If GetKeyValue(HKEY_CURRENT_USER, _
"Software\Microsoft\Internet Account Manager", _
"Default Mail Account", Temp) Then
If GetKeyValue(HKEY_CURRENT_USER, _
"Software\Microsoft\Internet Account Manager\Accounts" & Temp, _
"SMTP Email Address", Temp) Then
UserName = Temp
End If
End If

... je ne sais plus ce que doit représenter Temp dans la chaine, mais regarde dans la BdR.
Bien sur, il te faut le module avec les fonctions GetKeyValue ... et la constante HKEY_CURRENT_USER, mais ça se trouve partout. Sur vbFrance, cherche des sources qui causent de la Base de Registres.

Vala
Jack
colichon2000 Messages postés 4 Date d'inscription jeudi 11 décembre 2003 Statut Membre Dernière intervention 14 décembre 2003
12 déc. 2003 à 20:17
Merci Jack pour ta réponse, j'ai fait ce que tu m'as dit j'ai lancé mon script, mais j'ai toujour comme résultat 5 et 6 à la commande rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
KeyValType, tmpVal, KeyValSize)

ceci m'envoie toujours à GetKeyError.

Voici le script que j'ai fait: la partie principale est Command1_Click()

***************SCRIPT***********

Const HKEY_CURRENT_USER = &H80000001

Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private 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
Private 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
Private 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

Private Sub cmdSysInfo_Click()
Call StartSysInfo
End Sub

Private Sub cmdOK_Click()
Unload Me
End Sub

Public Sub Command1_Click()
Dim temp As String

If GetKeyValue(HKEY_CURRENT_USER, _
"Software\Microsoft\Internet Account Manager", _
"Default Mail Account", temp) Then
If GetKeyValue(HKEY_CURRENT_USER, _
"Software\Microsoft\Internet Account Manager\Accounts" & temp, _
"SMTP Email Address", temp) Then
UserName = temp
MsgBox (temp)
End If
End If
End Sub

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
Dim i As Long ' Compteur de boucle.
Dim rc As Long ' Code de retour.
Dim hKey As Long ' Descripteur d'une clé de base de registres ouverte.
Dim hDepth As Long '
Dim KeyValType As Long ' Type de données d'une clé de base de registres.
Dim tmpVal As String ' Stockage temporaire pour une valeur de clé de base de registres.
Dim KeyValSize As Long ' Taille de la variable de la clé de base de registres.
'------------------------------------------------------------
' Ouvre la clé de base de registres sous la racine clé {HKEY_LOCAL_MACHINE...}.
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Ouvre la clé de base de registres.
MsgBox (rc)
' If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Gère l'erreur...

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

'------------------------------------------------------------
' Extrait la valeur de la clé de base de registres...
'------------------------------------------------------------
rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
KeyValType, tmpVal, KeyValSize) ' Obtient/Crée la valeur de la clé.

MsgBox (rc)
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Gère l'erreur.

If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 ajoute une chaîne terminée par un caractère nul...
tmpVal = Left(tmpVal, KeyValSize - 1) ' Caractère nul trouvé, extrait de la chaîne.
Else ' WinNT ne termine pas la chaîne par un caractère nul...
tmpVal = Left(tmpVal, KeyValSize) ' Caractère nul non trouvé, extrait la chaîne uniquement.
End If
'------------------------------------------------------------
' Détermine le type de valeur de la clé pour la conversion...
'------------------------------------------------------------
Select Case KeyValType ' Recherche les types de données...
Case REG_SZ ' Type de données chaîne de la clé de la base de registres.
KeyVal = tmpVal ' Copie la valeur de la chaîne.
Case REG_DWORD ' Type de données double mot de la clé de base de registres.
For i = Len(tmpVal) To 1 Step -1 ' Convertit chaque bit.
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Construit la valeur caractère par caractère.
Next
KeyVal = Format$("&h" + KeyVal) ' Convertit le mot double en chaîne.
End Select

GetKeyValue = True ' Retour avec succès.
rc = RegCloseKey(hKey) ' Ferme la clé de base de registres
Exit Function ' Quitte.

GetKeyError: ' Réinitialise après qu'une erreur s'est produite...
KeyVal = "" ' Affecte une chaîne vide à la valeur de retour.
GetKeyValue = False ' Retour avec échec.
rc = RegCloseKey(hKey) ' Ferme la clé de base de registres.
End Function

Si tu peux m'aider ce serait SYMPA...

Salut à toi Jack
colichon2000 Messages postés 4 Date d'inscription jeudi 11 décembre 2003 Statut Membre Dernière intervention 14 décembre 2003
12 déc. 2003 à 20:20
Jack voici la vrai source j'avais oublier de retirer un commentaire...

j'ai donc fait ce que tu m'as dit j'ai lancé mon script, mais j'ai toujour comme résultat 5 à la commande rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)

ceci m'envoie toujours à GetKeyError.

Voici le script que j'ai fait (le bon cette fois): la partie principale est Command1_Click()

Const HKEY_CURRENT_USER = &H80000001

Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private 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
Private 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
Private 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

Private Sub cmdSysInfo_Click()
Call StartSysInfo
End Sub

Private Sub cmdOK_Click()
Unload Me
End Sub

Public Sub Command1_Click()
Dim temp As String
'Set myOLItem = myOLApp.CreateItem(olMailItem)
'aa = myOLItem.Entryname
If GetKeyValue(HKEY_CURRENT_USER, _
"Software\Microsoft\Internet Account Manager", _
"Default Mail Account", temp) Then
If GetKeyValue(HKEY_CURRENT_USER, _
"Software\Microsoft\Internet Account Manager\Accounts" & temp, _
"SMTP Email Address", temp) Then
UserName = temp
MsgBox (temp)
End If
End If
End Sub

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
Dim i As Long ' Compteur de boucle.
Dim rc As Long ' Code de retour.
Dim hKey As Long ' Descripteur d'une clé de base de registres ouverte.
Dim hDepth As Long '
Dim KeyValType As Long ' Type de données d'une clé de base de registres.
Dim tmpVal As String ' Stockage temporaire pour une valeur de clé de base de registres.
Dim KeyValSize As Long ' Taille de la variable de la clé de base de registres.
'------------------------------------------------------------
' Ouvre la clé de base de registres sous la racine clé {HKEY_LOCAL_MACHINE...}.
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Ouvre la clé de base de registres.
MsgBox (rc)
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Gère l'erreur...

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

'------------------------------------------------------------
' Extrait la valeur de la clé de base de registres...
'------------------------------------------------------------
rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
KeyValType, tmpVal, KeyValSize) ' Obtient/Crée la valeur de la clé.

MsgBox (rc)
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Gère l'erreur.

If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 ajoute une chaîne terminée par un caractère nul...
tmpVal = Left(tmpVal, KeyValSize - 1) ' Caractère nul trouvé, extrait de la chaîne.
Else ' WinNT ne termine pas la chaîne par un caractère nul...
tmpVal = Left(tmpVal, KeyValSize) ' Caractère nul non trouvé, extrait la chaîne uniquement.
End If
'------------------------------------------------------------
' Détermine le type de valeur de la clé pour la conversion...
'------------------------------------------------------------
Select Case KeyValType ' Recherche les types de données...
Case REG_SZ ' Type de données chaîne de la clé de la base de registres.
KeyVal = tmpVal ' Copie la valeur de la chaîne.
Case REG_DWORD ' Type de données double mot de la clé de base de registres.
For i = Len(tmpVal) To 1 Step -1 ' Convertit chaque bit.
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Construit la valeur caractère par caractère.
Next
KeyVal = Format$("&h" + KeyVal) ' Convertit le mot double en chaîne.
End Select

GetKeyValue = True ' Retour avec succès.
rc = RegCloseKey(hKey) ' Ferme la clé de base de registres
Exit Function ' Quitte.

GetKeyError: ' Réinitialise après qu'une erreur s'est produite...
KeyVal = "" ' Affecte une chaîne vide à la valeur de retour.
GetKeyValue = False ' Retour avec échec.
rc = RegCloseKey(hKey) ' Ferme la clé de base de registres.
End Function

Bonne chance à vous tous
colichon2000 Messages postés 4 Date d'inscription jeudi 11 décembre 2003 Statut Membre Dernière intervention 14 décembre 2003
14 déc. 2003 à 15:29
Jack,

J'avais mal copier les constantes des programmes pour aller dans la BDR, en modifiant cela, çà fonctionne.

Grand Merci à toi et bonne fin de WE
Rejoignez-nous