Get Email Id of currently logged in user

[nithinkm]

Hi anybody please send me the code or appropriate link to get Currently logged users Email-Id from Active directory.

Thanks in Advance

 

[DonkeyOte]

may be an issue if the alias on exchange does not equate to the NT username, also does your company use alias as valid address, ie:

jd@somewhere.com is valid address for john doe as is j.doe@somewhere.com

Test it, it may be that if you wish to assume alias = NT id that you can simply use the NT username + @somewhere.com as the basis for your email.

The NT id of active user can be ascertained in VBA using

Environ("username")

 

[nithinkm]

Thanks LASW10 for the reply

But that will help a little bit, my actual scenario is I need the Email-id of the logged user, coz im using this Email-ID as a parameter for getting some unique ID from database. Is der any way to get the email id directly or by passing the username from Active Directory.

Please help

 

[DonkeyOte]

The below could work assuming all running OL but requires OL object library be referenced in VBA

Function olCU()
Dim olNS As Outlook.NameSpace
Set olNS = Outlook.GetNamespace("MAPI")
olCU = olNS.CurrentUser.Address
End Function

To add an object library automatically you can use the GUID of the library itself

Set ID = ThisWorkbook.VBProject.References
ID.AddFromGuid "{00062FFF-0000-0000-C000-000000000046}", 9, 1

The references may need to change pending version etc...

Also, pending Office version you will also get OL VBA security warnings whilst running this code... you may be able to get this using an API call / CDO method.

Hopefully someone can provide a more elegant less dependent solution.

 

[nithinkm]

Hi thanks again for the reply

im using this code to get user email address from the active directory. But it works fine in my machine and shows the email adress but when i install this in clients pc it doesnt work. Im giving the code .............
Anybody please help
Code
====

Set oRoot = GetObject("ldap://rootDSE")
sDomain = oRoot.Get("defaultNamingContext")
Set oDomain = GetObject("LDAP://" & sDomain)
sBase = "<" & oDomain.ADsPath & ">"
LoggedIn = Environ("username")
sFilter = "(&(objectCategory=person)(objectClass=user)(name=" & LoggedIn & "))"
sAttribs = "adsPath"
sDepth = "subTree"
sQuery = sBase & ";" & sFilter & ";" & sAttribs & ";" & sDepth
Set Connection = New ADODB.Connection
Connection.Provider = "ADsDSOObject"
Connection.Open
Set RecSet = Connection.Execute(sQuery)
If Not RecSet.EOF And Not RecSet.BOF Then

Set User = GetObject(RecSet("adsPath"))

With User
On Error Resume Next
sAns = sAns & "Email Address: " & .EmailAddress & vbCrLf
MsgBox sAns
End With
End If

 

[DonkeyOte]

You will need to ensure that each client has the ADO object library referenced (VBA).

See earlier note re: adding object references via GUID which can be invoked on workbook_open event - eg

Private Sub Workbook_Open()
On Error Resume Next
Set ID = ThisWorkbook.VBProject.References
ID.AddFromGuid "{00000205-0000-0010-8000-00AA006D2EA4}", 2, 5
End Sub

where 2,5 = major,minor version