Adresse de courriel par défaut de l'utilisateur

Michel Pierron

02/12/2006 à 10:09

Bonjour Pierre;
Comme ceci peut être:

Private Function GetMailAddress() As String
Const mKey$ = "SMTP Email Address"
Const Path1$ = "HKCUSoftwareMicrosoft"
Const Path2$ = "Internet Account Manager"
Const Path3$ = "Accounts0000001"
With CreateObject("WScript.Shell")
GetMailAddress = .regread(Path1 & Path2 & Path3 & mKey)
End With
End Function

MP

"Pierre Archambault" a écrit dans le
message de news: vQ0ch.48487$

Bonjour à tous,

Je me demande s'il est possible (en VBA) de trouver l'adresse de courriel
par défaut de l'utilisateur actuel de la machine.

Merci de vos lumières

Pierre

Pierre Archambault

02/12/2006 à 19:55

Merci Michel,

J'ai testé ton code mais j'ai dû l'adapter pour qu'il fonctionne.

Étant donné que je ne connais pas d'avance le numéro "Account000000X",
voici le code que j'ai modifié. Dis-moi si je fais une erreur en procédant
de cette façon.
'-------------------------------------------------------
Private Function GetMailAddress() As String
Dim i As Integer
Dim j As Integer
Dim LaClé As String

Const Path1$ = "HKEY_CURRENT_USERSoftwareMicrosoft"
Const Path2$ = "Internet Account Manager"

Dim mKey$(2)
Dim Path3$(5)

For i = 1 To 5
Path3$(i) = "Accounts000000" & i & ""
Next i

mKey$(1) = "SMTP Email Address"
mKey$(2) = "NNTP Email Address"

For j = 1 To 2
For i = 1 To 5
LaClé = Path1 & Path2 & Path3$(i) & mKey$(j)
With CreateObject("WScript.Shell")
On Error Resume Next
GetMailAddress = .regread(LaClé)
If Err <> -2147024894 Then
Exit Function
End If
End With
Next i
Next j

End Function
'-------------------------------------------------------

Merci à l'avance.

Pierre

"Michel Pierron" a écrit dans le message de news:

Bonjour Pierre;
Comme ceci peut être:

Private Function GetMailAddress() As String
Const mKey$ = "SMTP Email Address"
Const Path1$ = "HKCUSoftwareMicrosoft"
Const Path2$ = "Internet Account Manager"
Const Path3$ = "Accounts0000001"
With CreateObject("WScript.Shell")
GetMailAddress = .regread(Path1 & Path2 & Path3 & mKey)
End With
End Function

MP

"Pierre Archambault" a écrit dans le
message de news: vQ0ch.48487$
Bonjour à tous,

Je me demande s'il est possible (en VBA) de trouver l'adresse de courriel
par défaut de l'utilisateur actuel de la machine.

Merci de vos lumières

Pierre

Michel Pierron

03/12/2006 à 13:11

Bonjour Pierre;
A mon avis, tu n'as pas besoin de te préoccuper de la clé NNTP Email
Address; il s'agit de l'addresse utilisée pour les news et c'est souvent une
adresse bidon pour éviter le spam. Par contre, tu as raison, un utilisateur
peut posséder plusieurs adresses e-mail et il est de bon goût de lui
proposer le choix en cas d'adresses multiples.
Perso, pour l'itération dans le chemin de base, je préfère utiliser WMI:

Sub GetUserMailAddresses()
Const HKCU = &H80000001 ' HKEY_CURRENT_USER
Const mKey$ = "SMTP Email Address"
Const strComputer = "." ' Local machine
Const kPath = "SoftwareMicrosoftInternet Account ManagerAccounts"
Dim arrSubKeys(), SubKey, arrNames()
Dim i%, m%, Bal() As String, strValue As String
With GetObject("winmgmts:{impersonationLevel=impersonate}!" _
& strComputer & "rootdefault:StdRegProv")
' Enum all folders in kPath
.EnumKey HKCU, kPath, arrSubKeys
For Each SubKey In arrSubKeys
If SubKey Like "000000*" Then
' Enum all names of key in kPath & "" & SubKey
.EnumValues HKCU, kPath & "" & SubKey, arrNames
For i = 0 To UBound(arrNames)
If arrNames(i) = mKey Then
' Get string value for each key
.GetStringValue HKCU, kPath & "" & SubKey, arrNames(i), strValue
If Len(strValue) Then
ReDim Preserve Bal(0 To m)
Bal(m) = strValue
m = m + 1
End If
End If
Next
End If
Next
End With
' For test:
On Error Resume Next ' If no found address
For i = 0 To UBound(Bal): MsgBox Bal(i): Next
End Sub

Amicalement;

"Pierre Archambault" a écrit dans le
message de news: 6%jch.94498$

Merci Michel,

J'ai testé ton code mais j'ai dû l'adapter pour qu'il fonctionne.

Étant donné que je ne connais pas d'avance le numéro "Account000000X",
voici le code que j'ai modifié. Dis-moi si je fais une erreur en procédant
de cette façon.
'-------------------------------------------------------
Private Function GetMailAddress() As String
Dim i As Integer
Dim j As Integer
Dim LaClé As String

Const Path1$ = "HKEY_CURRENT_USERSoftwareMicrosoft"
Const Path2$ = "Internet Account Manager"

Dim mKey$(2)
Dim Path3$(5)

For i = 1 To 5
Path3$(i) = "Accounts000000" & i & ""
Next i

mKey$(1) = "SMTP Email Address"
mKey$(2) = "NNTP Email Address"

For j = 1 To 2
For i = 1 To 5
LaClé = Path1 & Path2 & Path3$(i) & mKey$(j)
With CreateObject("WScript.Shell")
On Error Resume Next
GetMailAddress = .regread(LaClé)
If Err <> -2147024894 Then
Exit Function
End If
End With
Next i
Next j

End Function
'-------------------------------------------------------

Merci à l'avance.

Pierre

"Michel Pierron" a écrit dans le message de news:

Bonjour Pierre;
Comme ceci peut être:

Private Function GetMailAddress() As String
Const mKey$ = "SMTP Email Address"
Const Path1$ = "HKCUSoftwareMicrosoft"
Const Path2$ = "Internet Account Manager"
Const Path3$ = "Accounts0000001"
With CreateObject("WScript.Shell")
GetMailAddress = .regread(Path1 & Path2 & Path3 & mKey)
End With
End Function

MP

"Pierre Archambault" a écrit dans le
message de news: vQ0ch.48487$
Bonjour à tous,

Je me demande s'il est possible (en VBA) de trouver l'adresse de
courriel par défaut de l'utilisateur actuel de la machine.

Merci de vos lumières

Pierre

Bonjour Pierre;
A mon avis, tu n'as pas besoin de te préoccuper de la clé NNTP Email
Address; il s'agit de l'addresse utilisée pour les news et c'est souvent une
adresse bidon pour éviter le spam. Par contre, tu as raison, un utilisateur
peut posséder plusieurs adresses e-mail et il est de bon goût de lui
proposer le choix en cas d'adresses multiples.
Perso, pour l'itération dans le chemin de base, je préfère utiliser WMI:

Sub GetUserMailAddresses()
Const HKCU = &H80000001 ' HKEY_CURRENT_USER
Const mKey$ = "SMTP Email Address"
Const strComputer = "." ' Local machine
Const kPath = "SoftwareMicrosoftInternet Account ManagerAccounts"
Dim arrSubKeys(), SubKey, arrNames()
Dim i%, m%, Bal() As String, strValue As String
With GetObject("winmgmts:{impersonationLevel=impersonate}!\" _
& strComputer & "rootdefault:StdRegProv")
' Enum all folders in kPath
.EnumKey HKCU, kPath, arrSubKeys
For Each SubKey In arrSubKeys
If SubKey Like "000000*" Then
' Enum all names of key in kPath & "" & SubKey
.EnumValues HKCU, kPath & "" & SubKey, arrNames
For i = 0 To UBound(arrNames)
If arrNames(i) = mKey Then
' Get string value for each key
.GetStringValue HKCU, kPath & "" & SubKey, arrNames(i), strValue
If Len(strValue) Then
ReDim Preserve Bal(0 To m)
Bal(m) = strValue
m = m + 1
End If
End If
Next
End If
Next
End With
' For test:
On Error Resume Next ' If no found address
For i = 0 To UBound(Bal): MsgBox Bal(i): Next
End Sub

Amicalement;

"Pierre Archambault" <pierre.archambault@videotron.ca> a écrit dans le
message de news: 6%jch.94498$ed6.2290823@weber.videotron.net...

Merci Michel,

J'ai testé ton code mais j'ai dû l'adapter pour qu'il fonctionne.

Étant donné que je ne connais pas d'avance le numéro "Account000000X",
voici le code que j'ai modifié. Dis-moi si je fais une erreur en procédant
de cette façon.
'-------------------------------------------------------
Private Function GetMailAddress() As String
Dim i As Integer
Dim j As Integer
Dim LaClé As String

Const Path1$ = "HKEY_CURRENT_USERSoftwareMicrosoft"
Const Path2$ = "Internet Account Manager"

Dim mKey$(2)
Dim Path3$(5)

For i = 1 To 5
Path3$(i) = "Accounts000000" & i & ""
Next i

mKey$(1) = "SMTP Email Address"
mKey$(2) = "NNTP Email Address"

For j = 1 To 2
For i = 1 To 5
LaClé = Path1 & Path2 & Path3$(i) & mKey$(j)
With CreateObject("WScript.Shell")
On Error Resume Next
GetMailAddress = .regread(LaClé)
If Err <> -2147024894 Then
Exit Function
End If
End With
Next i
Next j

End Function
'-------------------------------------------------------

Merci à l'avance.

Pierre

"Michel Pierron" <michel.pierron@free.fr> a écrit dans le message de news:
OObsaGfFHHA.1280@TK2MSFTNGP04.phx.gbl...

Bonjour Pierre;
Comme ceci peut être:

Private Function GetMailAddress() As String
Const mKey$ = "SMTP Email Address"
Const Path1$ = "HKCUSoftwareMicrosoft"
Const Path2$ = "Internet Account Manager"
Const Path3$ = "Accounts0000001"
With CreateObject("WScript.Shell")
GetMailAddress = .regread(Path1 & Path2 & Path3 & mKey)
End With
End Function

MP

"Pierre Archambault" <pierre.archambault@videotron.ca> a écrit dans le
message de news: vQ0ch.48487$ed6.1470874@weber.videotron.net...

Bonjour à tous,

Je me demande s'il est possible (en VBA) de trouver l'adresse de
courriel par défaut de l'utilisateur actuel de la machine.

Merci de vos lumières

Pierre

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour Pierre;
A mon avis, tu n'as pas besoin de te préoccuper de la clé NNTP Email
Address; il s'agit de l'addresse utilisée pour les news et c'est souvent une
adresse bidon pour éviter le spam. Par contre, tu as raison, un utilisateur
peut posséder plusieurs adresses e-mail et il est de bon goût de lui
proposer le choix en cas d'adresses multiples.
Perso, pour l'itération dans le chemin de base, je préfère utiliser WMI:

Sub GetUserMailAddresses()
Const HKCU = &H80000001 ' HKEY_CURRENT_USER
Const mKey$ = "SMTP Email Address"
Const strComputer = "." ' Local machine
Const kPath = "SoftwareMicrosoftInternet Account ManagerAccounts"
Dim arrSubKeys(), SubKey, arrNames()
Dim i%, m%, Bal() As String, strValue As String
With GetObject("winmgmts:{impersonationLevel=impersonate}!" _
& strComputer & "rootdefault:StdRegProv")
' Enum all folders in kPath
.EnumKey HKCU, kPath, arrSubKeys
For Each SubKey In arrSubKeys
If SubKey Like "000000*" Then
' Enum all names of key in kPath & "" & SubKey
.EnumValues HKCU, kPath & "" & SubKey, arrNames
For i = 0 To UBound(arrNames)
If arrNames(i) = mKey Then
' Get string value for each key
.GetStringValue HKCU, kPath & "" & SubKey, arrNames(i), strValue
If Len(strValue) Then
ReDim Preserve Bal(0 To m)
Bal(m) = strValue
m = m + 1
End If
End If
Next
End If
Next
End With
' For test:
On Error Resume Next ' If no found address
For i = 0 To UBound(Bal): MsgBox Bal(i): Next
End Sub

Amicalement;

"Pierre Archambault" a écrit dans le
message de news: 6%jch.94498$

Merci Michel,

J'ai testé ton code mais j'ai dû l'adapter pour qu'il fonctionne.

Étant donné que je ne connais pas d'avance le numéro "Account000000X",
voici le code que j'ai modifié. Dis-moi si je fais une erreur en procédant
de cette façon.
'-------------------------------------------------------
Private Function GetMailAddress() As String
Dim i As Integer
Dim j As Integer
Dim LaClé As String

Const Path1$ = "HKEY_CURRENT_USERSoftwareMicrosoft"
Const Path2$ = "Internet Account Manager"

Dim mKey$(2)
Dim Path3$(5)

For i = 1 To 5
Path3$(i) = "Accounts000000" & i & ""
Next i

mKey$(1) = "SMTP Email Address"
mKey$(2) = "NNTP Email Address"

For j = 1 To 2
For i = 1 To 5
LaClé = Path1 & Path2 & Path3$(i) & mKey$(j)
With CreateObject("WScript.Shell")
On Error Resume Next
GetMailAddress = .regread(LaClé)
If Err <> -2147024894 Then
Exit Function
End If
End With
Next i
Next j

End Function
'-------------------------------------------------------

Merci à l'avance.

Pierre

"Michel Pierron" a écrit dans le message de news:

Bonjour Pierre;
Comme ceci peut être:

Private Function GetMailAddress() As String
Const mKey$ = "SMTP Email Address"
Const Path1$ = "HKCUSoftwareMicrosoft"
Const Path2$ = "Internet Account Manager"
Const Path3$ = "Accounts0000001"
With CreateObject("WScript.Shell")
GetMailAddress = .regread(Path1 & Path2 & Path3 & mKey)
End With
End Function

MP

"Pierre Archambault" a écrit dans le
message de news: vQ0ch.48487$
Bonjour à tous,

Je me demande s'il est possible (en VBA) de trouver l'adresse de
courriel par défaut de l'utilisateur actuel de la machine.

Merci de vos lumières

Pierre

Adresse de courriel par défaut de l'utilisateur

3 réponses

Veuillez sélectionner un problème