Solved

Need to extract some user account information from Active Directory

Posted on 2008-10-27
3
1,191 Views
Last Modified: 2012-06-21
I am needing a VBScript to that will query a txt file of user names, and then create an output csv file containing the follwoing information from Active Directory about the users.

First Name
Last Name
Title
Department
0
Comment
Question by:seaninman
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
3 Comments
 
LVL 10

Expert Comment

by:Alan_White
ID: 22814227
Are all the users you need to look up in a single OU?
0
 
LVL 4

Author Comment

by:seaninman
ID: 22814250
Sorry forgot to the put that.  No there are mulitiple OU's
0
 
LVL 3

Accepted Solution

by:
Angelized earned 500 total points
ID: 22819875
Here we go, lemme know if you need me to comment this code.
'Option Explicit
Dim oFSO, ForReading, ForWriting, objdialog, Intresult, userfile
Dim Mylist, myarray, username, sUserLDAPName, ts, report
ForReading = 1
ForWriting = 2
Set oFSO=CreateObject("Scripting.FileSystemObject")
Set objDialog = CreateObject("UserAccounts.CommonDialog")
 
objDialog.Filter = "Text Files|*.txt|All Files|*.*"
objDialog.FilterIndex = 1
intResult = objDialog.ShowOpen
If intResult = 0 Then
    Wscript.Quit
Else
    UserFile = objDialog.FileName
End If
 
MyList= ofso.OpenTextFile(UserFile, ForReading).ReadAll
myArray=Split(MyList,vbCrLf, -1, vbtextcompare)
 
For Each username In myarray 
	sUserLDAPName = QueryActiveDirectory(Trim(username))
	If sUserLDAPName <> "Not Found" Then
	   On Error Resume Next
	   Set objUser = GetObject("LDAP://" & sUserLDAPName) 
	   report = report & username
	   report = report & "," & CheckIfEmpty(objUser.Firstname)
	   report = report & "," & CheckIfEmpty(objUser.lastname)
	   report = report & "," & CheckIfEmpty(objUser.description)
	   report = report & "," & CheckIfEmpty(objUser.department)
	   report = report & vbCrLf
	End If  
Next
 
Set ts = oFSO.CreateTextFile ("output.csv", ForWriting)
ts.Write report
MsgBox "Done!"
	 
Function CheckIfEmpty (property)
  If IsEmpty(Property) Then 
     CheckIfEmpty = "N/a"
  Else
     CheckIfEmpty = property
  End if 
End Function
 
Function QueryActiveDirectory(sUsername)
'Function:      QueryActiveDirectory
'Purpose:       Search the Active Directory's Global Catalog for users
'Parameters:    UserName - user to search for
'Return:        The user's distinguished name
 
    Dim oAD 'As IADs
    Dim oGlobalCatalog 'As IADs
    Dim oRecordSet 'As Recordset
    Dim oConnection 'As New Connection
    Dim strADsPath 'As String
    Dim strQuery 'As String
    Dim strUPN 'As String
 
    Set oRecordSet = CreateObject("ADODB.Recordset")
    Set oConnection = CreateObject("ADODB.Connection")
 
    'Determine the global catalog path
    Set oAD = GetObject("GC:")
    For Each oGlobalCatalog In oAD
        strADsPath = oGlobalCatalog.ADsPath
    Next
    'Initialize the ADO object
    oConnection.Provider = "ADsDSOObject"
    'The ADSI OLE-DB provider
    oConnection.connectiontimeout = 15
    oConnection.Open "ADs Provider"
    'Create the search string
    'MsgBox strADsPath
    strQuery = "<" & strADsPath & _
      ">;(&(objectClass=user)(objectCategory=person)(samaccountName=" & _
      sUsername & "));userPrincipalName,cn,distinguishedName;subtree"
        'Execute the query
    'MsgBox strQuery
    Set oRecordSet = oConnection.Execute(strQuery)
    If oRecordSet.EOF And oRecordSet.BOF Then
       'An empty recordset was returned
        QueryActiveDirectory = "Not Found"
    Else    'Records were found; loop through them
        While Not oRecordSet.EOF
            QueryActiveDirectory = oRecordSet.Fields("distinguishedName")
            oRecordSet.MoveNext
        Wend
    End If
    oConnection.Close
    Set oConnection = Nothing
    Set oRecordSet = Nothing
End Function

Open in new window

0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Welcome back!  My apologies for taking so long to write part two of this series; it's been a long time coming!  As I promised in Part 1, this article will focus on how to locate those elusive AD properties that you are searching for.  Why is this us…
Introduction During my participation as a VBScript contributor at Experts Exchange, one of the most common questions I come across is this: "I have a script that runs against only one computer. How can I make it run against a list of computers in …
There are cases when e.g. an IT administrator wants to have full access and view into selected mailboxes on Exchange server, directly from his own email account in Outlook or Outlook Web Access. This proves useful when for example administrator want…
Add bar graphs to Access queries using Unicode block characters. Graphs appear on every record in the color you want. Give life to numbers. Hopes this gives you ideas on visualizing your data in new ways ~ Create a calculated field in a query: …

696 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question