"schvanson" <> wrote in message
news:...
>
> 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?
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)(direc tReports=*))"
' 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,givenNa me," _
& "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 Directory Services
Hilltop Lab -
http://www.rlmueller.net
--