RE: Querying Active Directory using VB?

Tech-Archive recommends: Repair Windows Errors & Optimize Windows Performance

That example is a bit inefficient, because it only uses ADO to retrieve
AdsPath, then binds to each user object to retrieve the other attribute
values needed. I explain how to use ADO in VBScript in this link:

http://www.rlmueller.net/ADOSearchTips.htm

The code is very similar in VB. The attribute you want is "mail" (unless you
use Exchange). Hopefully, the link above explains what you need to do.

Richard Mueller (MVP)

"DanielWalters6" wrote:

Hi Hope you can help...

I've borrowed then modified some code that runs in an Access Module, which
communicates with our smtp server and sends an internal email, to the
currently logged in person, confirming the action they took within my Access
Application.

EmailAddress = (Environ("Username")) & "@ourdomain.co.uk"

However I've just been made aware, that although that works with my email
(my username is the same at the first part of my email) there are about 200
users that don't follow this rule.

However, when using OutlookWA and I type in a username which doesn't conform
to this rule, it fills in the email address. ie, if I was to type in PAL,
click check names, it puts in the users email address.

After talking to the technicians, they said this information is stored in
the Active Directory.

Because of this, I need to query the Active Directory just before sending my
email, to return the email address of the currently logged in user.

I came accross the following VB code when googling, no explanation on the
page other than "querying active directory)

If someone could take the time to have a little look, and tell me what it's
doing, and how I could implement this, to return the email address, when
providing the username, I would be in your debt forever.

Thank you for any help you can provide.

Dan Walters


[code]

Public Function UserInfo(LoginName As String) As String
'PURPOSE: Display information that is available in
'the Active Directory about a given user

'PARAMETER: Login Name for user

'RETURNS: String with selected information about
'user, or empty string if there is no such
'login on the current domain

'REQUIRES: Windows 2000 ADSI, LDAP Provider
'Proper Security Credentials.

'EXAMPLE: msgbox UserInfo("Administrator")

Dim conn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim oRoot As IADs
Dim oDomain As IADs
Dim sBase As String
Dim sFilter As String
Dim sDomain As String

Dim sAttribs As String
Dim sDepth As String
Dim sQuery As String
Dim sAns As String

Dim user As IADsUser

On Error GoTo ErrHandler:

'Get user Using LDAP/ADO. There is an easier way
'to bind to a user object using the WinNT provider,
'but this way is a better for educational purposes
Set oRoot = GetObject("LDAP://rootDSE";)
'work in the default domain
sDomain = oRoot.Get("defaultNamingContext")
Set oDomain = GetObject("LDAP://"; & sDomain)
sBase = "<" & oDomain.ADsPath & ">"
'Only get user name requested
sFilter = "(&(objectCategory=person)(objectClass=user)(name=" _
& LoginName & "))"
sAttribs = "adsPath"
sDepth = "subTree"

sQuery = sBase & ";" & sFilter & ";" & sAttribs & ";" & sDepth

conn.Open _
"Data Source=Active Directory Provider;Provider=ADsDSOObject"

Set rs = conn.Execute(sQuery)

If Not rs.EOF Then
Set user = GetObject(rs("adsPath"))
With user

'if the attribute is not stored in AD,
'an error will occur. Therefore, this
'will return data only from populated attributes
On Error Resume Next

sAns = "First Name: " & .FirstName & vbCrLf
sAns = sAns & "Last Name " & .LastName & vbCrLf
sAns = sAns & "Employee ID: " & .EmployeeID & vbCrLf
sAns = sAns & "Title: " & .Title & vbCrLf
sAns = sAns & "Division: " & .Division & vbCrLf
sAns = sAns & "Department: " & .Department & vbCrLf
sAns = sAns & "Manager: " & .Manager & vbCrLf

sAns = sAns & "Phone Number: " & .TelephoneNumber & vbCrLf
sAns = sAns & "Fax Number: " & .FaxNumber & vbCrLf

sAns = sAns & "Email Address: " & .EmailAddress & vbCrLf
sAns = sAns & "Web Page: " & .HomePage & vbCrLf
sAns = sAns & "Last Login: " & .LastLogin & vbCrLf
sAns = sAns & "Last Logoff: " & .LastLogoff & vbCrLf

sAns = sAns & "Account Expiration Date: " _
& .AccountExpirationDate & vbCrLf

'IN RC2, this returned 1/1/1970 when password
'never expires option is set
sAns = sAns & "Password Expiration Date: " _
& .PasswordExpirationDate

End With
End If
UserInfo = sAns
ErrHandler:

On Error Resume Next
If Not rs Is Nothing Then
If rs.State <> 0 Then rs.Close
Set rs = Nothing
End If

If Not conn Is Nothing Then
If conn.State <> 0 Then conn.Close
Set conn = Nothing
End If

Set oRoot = Nothing
Set oDomain = Nothing
End Function

[/code]
.

Relevant Pages

  • Search pattern
    ... Dim strfile As String ... Dim bAddressFound As Boolean ... Dim strCurrentChar As String ...
    (comp.databases.ms-access)
  • Active Directory gives up group info for only SOME users
    ... Our ASP.NET app is secured with forms authentication and validates users ... against Active Directory. ... Private _filterAttribute As String ... Dim entry As DirectoryEntry = New DirectoryEntry(_path, domainAndUsername, ...
    (microsoft.public.dotnet.security)
  • AD only gives up group (role) information for SOME users
    ... Our ASP.NET app is secured with forms authentication and validates users ... against Active Directory. ... Private _filterAttribute As String ... Dim entry As DirectoryEntry = New DirectoryEntry(_path, domainAndUsername, ...
    (microsoft.public.dotnet.framework.aspnet.security)
  • Auto Write Name and Merge across
    ... Dim Sheetname01 As String ... Dim WeekName01 As String ...
    (microsoft.public.excel.misc)
  • Re: multiplatform (pocketPC & desktopPC) (Daniel !!)
    ... Friend Versione As String ... Public Sub GetMyConnectionPalmare() ... Dim errorMessages As String ... Private Function GetDS_Desktop(ByVal SQL As String) As DataSet ...
    (microsoft.public.dotnet.framework.compactframework)