How to List Users in Active Directory?

Aufgabe: Ausgabe von Users Objekten und den dazugehörigen Informationen.

Das beiliegende Script gibt alle Directory Einträge (Objekteigenschaft = USERs) aus in C:\temp\ad_user_list.csv (CSV – Format). Eingetragen werden müssen die zu durchsuchenden Domains. Es kann auch ein Start in einer bestimmten Organisationseinheit gewählt werden. Das Programm eignet sich für eine regelmäßige Ausgabe über den Task Scheduler, damit liegt immer eine aktuelle Liste der Einträge vor, die entsprechend abgegriffen und weiter verarbeitet werden kann.

Ausgegeben wird:

• Anmeldename;
• Nachname;
• Vorname;
• Telefon;
• ipPhone;
• Email;
• Ort;
• Strasse;
• ADSPfad;
• Department;
• Division;
• Company.

Die Laufzeit ist abhängig von der Domaingröße und den darin enthaltenen Objekten.

Der Codeblock

Private Sub Form_Load()
'Dimensionierung
Dim objAs, objUser, oDomain
Dim ListeOU(60000)
Dim strLDAPQuery
Dim objCON
Dim i, Bereich(3), DC(10)

AnzahlOU = 1
Open "C:\temp\ad_user_list.csv" For Output As #1
On Error Resume Next
Bereich(0) = ""
Bereich(1) = ""
Bereich(2) = ""

Print #1,
"Anmeldename;
Nachname;
Vorname;
Telefon;
ipPhone;
Email;
Ort;
Strasse;
ADSPfad;
Department;
Division;
Company;
Beschreibung;"

For i = 0 To 2
Set objCON = CreateObject("ADODB.Connection")
CONSTRING = "Provider=ADSDSOObject"
objCON.Open CONSTRING
strLDAPQuery = Bereich(i) &_
";(objectclass=organizationalUnit);samaccountname,adspath;subtree"
Set rs = objCON.Execute(strLDAPQuery)

While Not rs.EOF
     ListeOU(AnzahlOU) = rs("adspath")
     If InStr(1, ListeOU(AnzahlOU), "User") Then
      If InStr(1, ListeOU(AnzahlOU), Mid(Bereich(i), 9, 3)) Then
       Set oDomain = GetObject(ListeOU(AnzahlOU))
       oDomain.Filter = Array("user")
       For Each oUser In oDomain
         ADSPfad = oUser.ADsPath
         oUser.GetInfo
         If oUser.LastName = "" Then
           nachname = " "
         Else
           nachname = oUser.LastName
         End If
         If oUser.FirstName = "" Then
           Vorname = " "
         Else
           Vorname = oUser.FirstName
         End If
         If oUser.Get("mail") = "" Then
           mail = " "
         Else
           mail = oUser.Get("mail")
         End If
         If oUser.department = "" Then
           department = "?"
         Else
           department = oUser.department
         End If
         If oUser.Get("l") = "" Then
           l = " "
         Else
           l = oUser.Get("l")
         End If
         If oUser.Get("streetAddress") = "" Then
           street = " "
         Else
           street = oUser.Get("streetAddress")
         End If
         If oUser.Get("TelephoneNumber") = "" Then
           Telefon = " "
         Else
           Telefon = oUser.Get("TelephoneNumber")
         End If
         If oUser.Get("ipPhone") = "" Then
           ipPhone = " "
         Else
           ipPhone = oUser.Get("ipPhone")
         End If
         If oUser.Get("division") = "" Then
           division = " "
         Else
           division = oUser.Get("division")
         End If
         If oUser.Get("company") = "" Then
           company = " "
         Else
           company = oUser.Get("company")
         End If
         If oUser.Get("description") = "" Then
           beschreibung = " "
         Else
           beschreibung = oUser.Get("description")
         End If
       
         Print #1,Chr(34) & 
         oUser.Get("SAMAccountname") & Chr(34) & ";" & Chr(34) & 
         nachname & Chr(34) & ";" & Chr(34) & 
         Vorname & Chr(34) & ";" & Chr(34) & 
         Telefon & Chr(34) & ";" & Chr(34) & 
         ipPhone & Chr(34) & ";" & Chr(34) & 
         mail & Chr(34) & ";" & Chr(34) & 
         l & Chr(34) & ";" & Chr(34) & 
         street & Chr(34) & ";" & Chr(34) & 
         ADSPfad & Chr(34) & ";" & Chr(34) & 
         department & Chr(34) & ";" & Chr(34) & 
         division & Chr(34) & ";" & Chr(34) & 
         company & Chr(34) & ";" & Chr(34) & 
         beschreibung & Chr(34) & ";"
       
       Next
      End If
     End If
     AnzahlOU = AnzahlOU + 1
     rs.MoveNext
Wend

Next i

Close #1
Unload Form1
End Sub