Bind to the user object in Active Directory with the LDAP provider.

I had to get the email address of the current user logged onto a PC using Word VBA today.

I decided to look around for code to pull this from Active Directory.I found a good piece of code that will bind to the current logged on users object in Active Directory using the LDAP provider.

Thanks to Richard Mueller for posting the code on usenet: http://groups.google.co.uk/group/microsoft.public.adsi.general/browse_thread/thread/14ddf396e723a2e9/15dae72e5a730ee2?lnk=st&q=%22EmailAddress%22+property&rnum=1&hl=en#15dae72e5a730ee2

You can expand the below code to pull any property methods available for user objects. A spreadsheet can be found here:
http://www.rlmueller.net/References/PropertyMethods.xls

Public Function Email() As String

  'Example using NameTranslate to convert NT logon name to Distinguished Name:

  Dim objNetwork As Variant
  Dim objRootDSE As Variant
  Dim objTrans As Variant
  Dim objUser As Variant
  Dim strDNSDomain As String
  Dim strNTName As String
  Dim strNetBIOSDomain As String
  Dim strUserDN As String


  Set objNetwork = CreateObject("Wscript.Network")
  strNTName = objNetwork.UserName


  ' Determine DNS domain name from RootDSE object.
  Set objRootDSE = GetObject("LDAP://RootDSE")
  strDNSDomain = objRootDSE.Get("defaultNamingContext")


  ' Use the NameTranslate object to find the NetBIOS domain name from the
  ' DNS domain name.
  Set objTrans = CreateObject("NameTranslate")
  objTrans.Init 3, strDNSDomain
  objTrans.Set 1, strDNSDomain
  strNetBIOSDomain = objTrans.Get(3)
  ' Remove trailing backslash
  strNetBIOSDomain = Left(strNetBIOSDomain, Len(strNetBIOSDomain) - 1)


  ' Use the NameTranslate object to convert the NT user name to the
  ' Distinguished Name required for the LDAP provider.
  objTrans.Init 1, strNetBIOSDomain
  objTrans.Set 3, strNetBIOSDomain & "\" & strNTName
  strUserDN = objTrans.Get(1)


  ' Bind to the user object in Active Directory with the LDAP provider.
  Set objUser = GetObject("LDAP://" & strUserDN)

  Email = objUser.Get("mail")


End Function