VBScript,Getting the Manager's Display Name

[schvanson]

I have a very basic script that I created to pull data from all AD user accounts and exports them into a .XLS. The only issue I have is that the Manager field is pulling the distingushedName and I need it to show the displayName. I have tried the Ltrim, Rtrim and Mid attributes but cannot get it to work. Any help will be greatly appreciated.

Below is the code. Feel free to use it!

Const ADS_SCOPE_SUBTREE = 2

Const xlAscending = 1
Const xlDescending = 2
Const xlYes = 1

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = False
Set objWorkbook = objExcel.Workbooks.Add
Set objWorksheet = objWorkbook.Worksheets(1)

' Make bold
objExcel.Range("A1:N1").Select
objExcel.Selection.Font.Bold = True

' Name Columns
objExcel.Cells(1, 1).Value = "Employee ID"
objExcel.Cells(1, 2).Value = "First Name"
objExcel.Cells(1, 3).Value = "Middle Initial"
objExcel.Cells(1, 4).Value = "Last Name"
objExcel.Cells(1, 5).Value = "Full Name"
objExcel.Cells(1, 6).Value = "Description"
objExcel.Cells(1, 7).Value = "Job Title"
objExcel.Cells(1, 8).Value = "NT Login ID"
objExcel.Cells(1, 9).Value = "Email"
objExcel.Cells(1, 10).Value = "Office Phone"
objExcel.Cells(1, 11).Value = "Cell Phone"
objExcel.Cells(1, 12).Value = "Department Name"
objExcel.Cells(1, 13).Value = "Company name"
objExcel.Cells(1, 14).Value = "Manager"

' Use ADO to search Active Directory
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 100
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
objCommand.CommandText = _
	"SELECT displayName, samAccountName, EmployeeID, givenName, initials, sn, Description, title, mail, department, physicalDeliveryOfficeName, Manager, telephoneNumber, msExchHomeServerName, homeMDB, MOBILE, distinguishedName, Title, Company FROM " _
        & "'LDAP://dc=na,dc=calpine,dc=com' WHERE " _
            & "objectCategory='user'" 
Set objRecordSet = objCommand.Execute

objRecordSet.MoveFirst
  
x = 2

' Pull Data
	Do Until objRecordSet.EOF
    objExcel.Cells(x, 1).Value = _
        objRecordSet.Fields("EmployeeID").Value
    	objExcel.Cells(x, 2).Value = _
        objRecordSet.Fields("givenName").Value
		objExcel.Cells(x, 3).Value = _
        objRecordSet.Fields("initials").Value
		objExcel.Cells(x, 4).Value = _
        objRecordSet.Fields("sn").Value
		objExcel.Cells(x, 5).Value = _
        objRecordSet.Fields("displayName").Value
		objExcel.Cells(x, 6).Value = _
        objRecordSet.Fields("Description").Value
		objExcel.Cells(x, 7).Value = _
        objRecordSet.Fields("title").Value
		objExcel.Cells(x, 8).Value = _
        objRecordSet.Fields("samAccountName").Value
		objExcel.Cells(x, 9).Value = _
        objRecordSet.Fields("mail").Value
		objExcel.Cells(x, 10).Value = _
        objRecordSet.Fields("telephoneNumber").Value
		objExcel.Cells(x, 11).Value = _
        objRecordSet.Fields("mobile").Value
		objExcel.Cells(x, 12).Value = _
        objRecordSet.Fields("department").Value
		objExcel.Cells(x, 13).Value = _
        objRecordSet.Fields("Company").Value
		objExcel.Cells(x, 14).Value = _
		objRecordset.Fields("Manager").Value
		x = x + 1
					
		objRecordSet.MoveNext
Loop

objExcel.Visible = True

Set objRange = objExcel.Range("A1:N1")
objRange.Activate

Set objRange = objExcel.Selection.EntireColumn
objRange.Autofit()

' Auto Sort
Set objRange = objWorksheet.UsedRange
Set objRange2 = objExcel.Range("A1")
objRange.Sort objRange2, xlDescending, , , , , , xlYes

' Clean up.
Set objRootDSE = Nothing
Set objCommand = Nothing
Set objConnection = Nothing
Set objRecordSet = Nothing

[Richard Mueller [MVP]]

As you noted, the value of the manager attribute is a Distinguished Name
(DN). If by the display name you mean the common name, then you could parse
the DN for this value. Perhaps this function would help:
==========
Function GetCN(ByVal strDN)
' Function to parse the DN of a user object to retrieve
' the Common Name of the user.
Dim intIndex
' Assume the DN is that of a user object, so it begins
' with the string "cn=". Strip this string off.
strDN = Mid(strDN, 4)
' First check if user object in a container.
intIndex = InStr(LCase(strDN), ",cn=")
If (intIndex = 0) Then
' User object must be in an OU.
intIndex = InStr(LCase(strDN), ",ou=")
End If
' Remove DN of parent container/OU.
GetCN = Left(strDN, intIndex - 1)
End Function
=========
Note that this will not handle any escaped characters, such as commas, by
un-escaping them. The most reliable method would require using the value of
the manager attribute to bind to the corresponding user object, then
retrieve the value of the cn attribute.

And, if by display name you mean the value of the displayName attribute, you
definitely must bind to the manager object. This will significantly slow the
script, but is the best procedure. Since you are retrieving information on
all users in the domain, you could make the script more efficient by first
querying for all users that have one or more values assigned to the
directReports attribute, and retrieve the value (such as Common Name)
required, and use this to populate a dictionary object. Then you can query
for all users (and the attributes in your list), and use the dictionary
object to convert the DN of the manager to value desired.

[Richard Mueller [MVP]]

I tested my suggestion (to query first for managers to retrieve the name
value desired, then query for all users) in my test domain to make sure it
worked. Here is the script I used:
===========
Option Explicit

Dim objRootDSE, strDNSDomain, adoConnection
Dim strBase, strFilter, strAttributes, strQuery, adoRecordset
Dim strName, strDN, objManagerList, strManagerDN, strManager

Set objManagerList = CreateObject("Scripting.Dictionary")
objManagerList.CompareMode = vbTextCompare

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

' Use ADO to search Active Directory.
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"

Set adoRecordset = CreateObject("ADODB.Recordset")
adoRecordset.ActiveConnection = adoConnection

' Search entire domain.
strBase = "<LDAP://" & strDNSDomain & ">"

' Filter on users with direct reports. These are managers.
strFilter = "(&(objectCategory=person)(objectClass=user)(directReports=*))"

' Comma delimited list of attribute values to retrieve.
strAttributes = "distinguishedName,cn"

' Construct the LDAP query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

' Run the query.
adoRecordset.Source = strQuery
adoRecordset.Open

' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
' Retrieve values.
strName = adoRecordset.Fields("cn").Value
strDN = adoRecordset.Fields("distinguishedName").Value
' Add to dictionary object.
objManagerList.Add strDN, strName
adoRecordset.MoveNext
Loop
adoRecordset.Close

' Now filter on all users.
' Filter on users with direct reports.
strFilter = "(&(objectCategory=person)(objectClass=user))"

' Comma delimited list of attribute values to retrieve.
strAttributes = "distinguishedName,cn,manager"

' Construct the LDAP query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

' Run the query.
adoRecordset.Source = strQuery
adoRecordset.Open

' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
' Retrieve values.
strName = adoRecordset.Fields("cn").Value
strDN = adoRecordset.Fields("distinguishedName").Value
strManagerDN = adoRecordset.Fields("manager").Value & ""
If (strManagerDN <> "") Then
strManager = objManagerList(strManagerDN)
Else
strManager = "<None>"
End If
' Display values.
Wscript.Echo strDN & ";" & strName & ";" & strManager
adoRecordset.MoveNext
Loop

' Clean up.
adoRecordset.Close
adoConnection.Close
======
Note that the displayName attribute would not be a good one to use, as it is
optional. You could use sAMAccountName. I hope this helps.

[schvanson]

I will work with this first thing Monday and report back.

And now for a little brown nosing :)
Every time I do a search to learn more about VB Scripting your site comes up and most times has exactly what I need. Thank you for all your help. Here and from your site.

I ran the script (changing it to show the sAMAccountName) and it pulled the data but would not display the Manager when running it. I modified it to push the data to excel and it is still displaying the DN for the manager. Do I need to run the previous script you provided in conjunction with the second one?

That almost did it. The only issue is that for some reason it is not pulling about 1600 user accounts. I will figure this out though.

I want to thank you for all your help and expertise in getting this working for me!

Ok, I have failed to figure this one out. It is pulling only 1000 accounts out of a little more than 2600. The original script I posted pulls them all but I can't determine the difference or what is causing the issue. Can any one help?

[Richard Mueller [MVP]]

The following worked for me in my test domain. I added steps to save the
spreadsheet at the end. I also added steps to close the spreadsheet and quit
Excel. If you leave the spreadsheet displayed to the user, I guess the user
could do these things manually (or print). Remember if the script halts
because of an error, there will be an instance of Excel running in memory.
When this happens to me I use task manager to close it.

The script first queries for all managers to retrieve their NT names, and
populates a dictionary object so we can later convert DN values to
sAMAccountName's. Then the recordset is re-opened with the query for all
users. This recordset is used to write values to the spreadsheet. I have the
code write "<None>" if the user has no manager, but you could leave the cell
empty instead.
============
Option Explicit

Dim objRootDSE, strDNSDomain, adoConnection
Dim strBase, strFilter, strAttributes, strQuery, adoRecordset
Dim strName, strDN, objManagerList, strManagerDN
Dim objExcel, objWorkbook, objWorkSheet, x, objRange, objRange2
Dim strExcelPath

Const xlAscending = 1
Const xlDescending = 2
Const xlYes = 1

' Specify spreadsheet.
strExcelPath = "c:\Scripts\AllUsers.xls"

Set objManagerList = CreateObject("Scripting.Dictionary")
objManagerList.CompareMode = vbTextCompare

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

' Use ADO to search Active Directory.
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"

Set adoRecordset = CreateObject("ADODB.Recordset")
adoRecordset.ActiveConnection = adoConnection

' Search entire domain.
strBase = "<LDAP://" & strDNSDomain & ">"

' Filter on users with direct reports. These are managers.
strFilter = "(&(objectCategory=person)(objectClass=user)(directReports=*))"

' Comma delimited list of attribute values to retrieve.
strAttributes = "distinguishedName,sAMAccountName"

' Construct the LDAP query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

' Run the query.
adoRecordset.Source = strQuery
adoRecordset.Open

' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
' Retrieve values.
strName = adoRecordset.Fields("sAMAccountName").Value
strDN = adoRecordset.Fields("distinguishedName").Value
' Add to dictionary object.
objManagerList.Add strDN, strName
adoRecordset.MoveNext
Loop
adoRecordset.Close

' Setup spreadsheet.
Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = False
Set objWorkbook = objExcel.Workbooks.Add
Set objWorksheet = objWorkbook.Worksheets(1)

' Make bold
objExcel.Range("A1:N1").Select
objExcel.Selection.Font.Bold = True

' Name Columns
objExcel.Cells(1, 1).Value = "Employee ID"
objExcel.Cells(1, 2).Value = "First Name"
objExcel.Cells(1, 3).Value = "Middle Initial"
objExcel.Cells(1, 4).Value = "Last Name"
objExcel.Cells(1, 5).Value = "Full Name"
objExcel.Cells(1, 6).Value = "Description"
objExcel.Cells(1, 7).Value = "Job Title"
objExcel.Cells(1, 8).Value = "NT Login ID"
objExcel.Cells(1, 9).Value = "Email"
objExcel.Cells(1, 10).Value = "Office Phone"
objExcel.Cells(1, 11).Value = "Cell Phone"
objExcel.Cells(1, 12).Value = "Department Name"
objExcel.Cells(1, 13).Value = "Company name"
objExcel.Cells(1, 14).Value = "Manager"

' Now filter on all users.
strFilter = "(&(objectCategory=person)(objectClass=user))"

' Comma delimited list of attribute values to retrieve.
strAttributes = "displayName,sAMAccountName,employeeID,givenName," _
& "initials,sn,description,title,mail,department," _
& "manager,telephoneNumber,mobile,company"

' Construct the LDAP query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

' Run the query.
adoRecordset.Source = strQuery
adoRecordset.Open

' Enumerate the resulting recordset.
x = 2
Do Until adoRecordset.EOF
' Retrieve values and write to spreadsheet.
objExcel.Cells(x, 1).Value = adoRecordset.Fields("employeeID").Value
objExcel.Cells(x, 2).Value = adoRecordset.Fields("givenName").Value
objExcel.Cells(x, 3).Value = adoRecordset.Fields("initials").Value
objExcel.Cells(x, 4).Value = adoRecordset.Fields("sn").Value
objExcel.Cells(x, 5).Value = adoRecordset.Fields("displayName").Value
objExcel.Cells(x, 6).Value = adoRecordset.Fields("description").Value
objExcel.Cells(x, 7).Value = adoRecordset.Fields("title").Value
objExcel.Cells(x, 8).Value = adoRecordset.Fields("sAMAccountName").Value
objExcel.Cells(x, 9).Value = adoRecordset.Fields("mail").Value
objExcel.Cells(x, 10).Value =
adoRecordset.Fields("telephoneNumber").Value
objExcel.Cells(x, 11).Value = adoRecordset.Fields("mobile").Value
objExcel.Cells(x, 12).Value = adoRecordset.Fields("department").Value
objExcel.Cells(x, 13).Value = adoRecordset.Fields("company").Value
strManagerDN = adoRecordset.Fields("manager").Value & ""
If (strManagerDN <> "") Then
objExcel.Cells(x, 14).Value = objManagerList(strManagerDN)
Else
objExcel.Cells(x, 14).Value = "<None>"
End If
x = x + 1
adoRecordset.MoveNext
Loop

objExcel.Visible = True

Set objRange = objExcel.Range("A1:N1")
objRange.Activate

Set objRange = objExcel.Selection.EntireColumn
objRange.Autofit()

' Auto Sort
Set objRange = objWorksheet.UsedRange
Set objRange2 = objExcel.Range("A1")
objRange.Sort objRange2, xlDescending, , , , , , xlYes

' Save the spreadsheet.
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close

' Quit Excel
objExcel.Application.Quit

' Clean up.
adoRecordset.Close
adoConnection.Close

[Richard Mueller [MVP]]

My fault. I should have turned on paging. This is needed to retrieve more
than 1000 rows in the recordset. For this we need to use an ADO command
object, so we can assign the "Page Size" property. The value assigned is not
important, as long as we assign a value between 100 and 1000. The program I
posted earlier would be revised as follow:
==============
Option Explicit

Dim objRootDSE, strDNSDomain, adoConnection
Dim strBase, strFilter, strAttributes, strQuery, adoRecordset
Dim strName, strDN, objManagerList, strManagerDN
Dim objExcel, objWorkbook, objWorkSheet, x, objRange, objRange2
Dim strExcelPath, adoCommand

Const xlAscending = 1
Const xlDescending = 2
Const xlYes = 1

' Specify spreadsheet.
strExcelPath = "c:\Scripts\AllUsers.xls"

Set objManagerList = CreateObject("Scripting.Dictionary")
objManagerList.CompareMode = vbTextCompare

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

' Use ADO to search Active Directory.
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand = CreateObject("ADODB.Command")
Set adoCommand.ActiveConnection = adoConnection

' Search entire domain.
strBase = "<LDAP://" & strDNSDomain & ">"

' Filter on users with direct reports. These are managers.
strFilter = "(&(objectCategory=person)(objectClass=user)(directReports=*))"

' Comma delimited list of attribute values to retrieve.
strAttributes = "distinguishedName,sAMAccountName"

' Construct the LDAP query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

' Run the query.
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute

' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
' Retrieve values.
strName = adoRecordset.Fields("sAMAccountName").Value
strDN = adoRecordset.Fields("distinguishedName").Value
' Add to dictionary object.
objManagerList.Add strDN, strName
adoRecordset.MoveNext
Loop
adoRecordset.Close

' Setup spreadsheet.
Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = False
Set objWorkbook = objExcel.Workbooks.Add
Set objWorksheet = objWorkbook.Worksheets(1)

' Make bold
objExcel.Range("A1:N1").Select
objExcel.Selection.Font.Bold = True

' Name Columns
objExcel.Cells(1, 1).Value = "Employee ID"
objExcel.Cells(1, 2).Value = "First Name"
objExcel.Cells(1, 3).Value = "Middle Initial"
objExcel.Cells(1, 4).Value = "Last Name"
objExcel.Cells(1, 5).Value = "Full Name"
objExcel.Cells(1, 6).Value = "Description"
objExcel.Cells(1, 7).Value = "Job Title"
objExcel.Cells(1, 8).Value = "NT Login ID"
objExcel.Cells(1, 9).Value = "Email"
objExcel.Cells(1, 10).Value = "Office Phone"
objExcel.Cells(1, 11).Value = "Cell Phone"
objExcel.Cells(1, 12).Value = "Department Name"
objExcel.Cells(1, 13).Value = "Company name"
objExcel.Cells(1, 14).Value = "Manager"

' Now filter on all users.
strFilter = "(&(objectCategory=person)(objectClass=user))"

' Comma delimited list of attribute values to retrieve.
strAttributes = "displayName,sAMAccountName,employeeID,givenName," _
& "initials,sn,description,title,mail,department," _
& "manager,telephoneNumber,mobile,company"

' Construct the LDAP query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

' Run the query.
adoCommand.CommandText = strQuery
Set adoRecordset = adoCommand.Execute

' Enumerate the resulting recordset.
x = 2
Do Until adoRecordset.EOF
' Retrieve values and write to spreadsheet.
objExcel.Cells(x, 1).Value = adoRecordset.Fields("employeeID").Value
objExcel.Cells(x, 2).Value = adoRecordset.Fields("givenName").Value
objExcel.Cells(x, 3).Value = adoRecordset.Fields("initials").Value
objExcel.Cells(x, 4).Value = adoRecordset.Fields("sn").Value
objExcel.Cells(x, 5).Value = adoRecordset.Fields("displayName").Value
objExcel.Cells(x, 6).Value = adoRecordset.Fields("description").Value
objExcel.Cells(x, 7).Value = adoRecordset.Fields("title").Value
objExcel.Cells(x, 8).Value = adoRecordset.Fields("sAMAccountName").Value
objExcel.Cells(x, 9).Value = adoRecordset.Fields("mail").Value
objExcel.Cells(x, 10).Value =
adoRecordset.Fields("telephoneNumber").Value
objExcel.Cells(x, 11).Value = adoRecordset.Fields("mobile").Value
objExcel.Cells(x, 12).Value = adoRecordset.Fields("department").Value
objExcel.Cells(x, 13).Value = adoRecordset.Fields("company").Value
strManagerDN = adoRecordset.Fields("manager").Value & ""
If (strManagerDN <> "") Then
objExcel.Cells(x, 14).Value = objManagerList(strManagerDN)
Else
objExcel.Cells(x, 14).Value = "<None>"
End If
x = x + 1
adoRecordset.MoveNext
Loop

objExcel.Visible = True

Set objRange = objExcel.Range("A1:N1")
objRange.Activate

Set objRange = objExcel.Selection.EntireColumn
objRange.Autofit()

' Auto Sort
Set objRange = objWorksheet.UsedRange
Set objRange2 = objExcel.Range("A1")
objRange.Sort objRange2, xlDescending, , , , , , xlYes

' Save the spreadsheet.
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close

' Quit Excel
objExcel.Application.Quit

' Clean up.
adoRecordset.Close
adoConnection.Close

[schvanson]

Ahh I was on the right trail just didn't put it in the correct place. I am still running into an issue on line 45 (adoCommand.CommandText = strQuery) it is missing a " is there something I am missing?

[schvanson]

SUCCESS = No More Errors!

I was able to tweak it and finally got it to pull everything correctly. Thanks again for the help Richard.