• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1201
  • Last Modified:

Need to extract some user account information from Active Directory

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
seaninman
Asked:
seaninman
1 Solution
 
Alan_WhiteCommented:
Are all the users you need to look up in a single OU?
0
 
seaninmanAuthor Commented:
Sorry forgot to the put that.  No there are mulitiple OU's
0
 
AngelizedCommented:
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

Receive 1:1 tech help

Solve your biggest tech problems alongside global tech experts with 1:1 help.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now