Trouver l'adresse email par défaut d'un user (outlook)
colichon2000
Messages postés4Date d'inscriptionjeudi 11 décembre 2003StatutMembreDernière intervention14 décembre 2003
-
11 déc. 2003 à 20:37
colichon2000
Messages postés4Date d'inscriptionjeudi 11 décembre 2003StatutMembreDernière intervention14 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
A voir également:
Trouver l'adresse email par défaut d'un user (outlook)
cs_Jack
Messages postés14006Date d'inscriptionsamedi 29 décembre 2001StatutModérateurDernière intervention28 août 201579 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.
colichon2000
Messages postés4Date d'inscriptionjeudi 11 décembre 2003StatutMembreDernière intervention14 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
colichon2000
Messages postés4Date d'inscriptionjeudi 11 décembre 2003StatutMembreDernière intervention14 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