Active Directory mit Excel (VBA) auslesen

[cmrhockey]

Hallo!

Habe die Aufgabe bekommen, aus dem Active Directory alle User und Gruppen auszulesen. Diese sollen dann in einer Tabelle so dargestellt werden, dass die Benutzer in einer Zeile untereinander stehen und die Gruppen in einer Spalte nebeneinander als Überschriften.

Dann soll ein x anzeigen, ob ein Benutzer in einer Gruppe ist oder nicht.

Mein Problem ist nun erstmal überhaupt an das Active Directory dranzukommen.

Kann mir einer mit Tips, Tricks und Informationen weiterhelfen?

Gruß Christian

[Enno]

Hier mal nen Script in VBS mit dem das ganze AD ausgelesen wird und dazu alle Mailadressen aller User in einer Datei gespeichert werden.

Option Explicit

'-------------------------------------------------------------------------

' smtplist.1.0.vbs

'

' Beschreibung:

'

' Generiert eine Liste aller SMTP-Adressen in der Organisation

' Optional mit der Abfrage einer Gruppe

'

' Laufzeitfehler werde nicht abgefangen und beenden das Skript.

'

' Das Skript wird mit den Berechtigungen des angemeldeten Benutzers

' ausgef?hrt. Die entsprechenden Berechtigungen sind sicher zu stellen

'

' ©2004 Net at Work Netzwerksysteme GmbH

'

' Version 1.0 (10. Mai 2005)

' + erste Version

'

' Denkbare Erweiterung: Filterung auf Mitglieder der Gruppe "InternetmaiL"

' oder Ausschluss von "KeinMail"

'-------------------------------------------------------------------------

Const LogFile = "smtplist.log" ' Pfad und Dateiname der Log-Datei

Const LogLevel = 5 ' errorlogging 0=no logging, 1=Fatal 2=Error 3=Warning 4=information 5=debug

Const outFile = "smtplist.txt" ' Pfad und Dateiname der Log-Datei

Dim count, total '

Dim file

Dim fs

Dim mail '

Dim name '

Dim uname '

Dim objCommand '

Dim objConnection '

Dim objRecordSet '

Dim oCont '

Dim strADsPath '

Dim strAttributes '

Dim strBase '

Dim strDN '

Dim strFilter '

Dim strQuery '

Dim oGC

Dim proxyAddresses

WScript.Echo WScript.ScriptName & " wurde gestartet."

AppendLog "Skript gestartet", 4

Set oCont = GetObject("GC:") 'Find the Global Catalog server

For Each oGC In oCont

strADsPath = oGC.ADsPath

Next

Set objCommand = CreateObject("ADODB.Command") ' mit ADO das Active Directory durchsuchen

Set objConnection = CreateObject("ADODB.Connection")

objConnection.Provider = "ADsDSOObject"

objConnection.Open "Active Directory Provider"

objCommand.ActiveConnection = objConnection

strBase = "<" & strADsPath & ">" ' Gesamten GC: durchsuchen

strFilter = "(ProxyAddresses=*)"

strAttributes = "ProxyAddresses,cn,distinguishedName" ' Gesuchte Attribute

strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree" ' LDAP query zusammenbauen

objCommand.CommandText = strQuery

objCommand.Properties("Page Size") = 100 ' max 100 Ergebnisse auf einmal erhalten

objCommand.Properties("Timeout") = 30 ' Timeout 30 Sekunden

objCommand.Properties("Cache Results") = False

Set objRecordSet = objCommand.Execute ' Und los

count = 0

total = 0

Set fs = CreateObject("Scripting.FileSystemObject")

Set file = fs.OpenTextFile(outFile, 2, True) ' Ausgabedatei zum ?berschreiben ?ffnen

Do Until objRecordSet.EOF ' jeden Datensatz einzeln bearbeiten.

count = count + 1

strDN = objRecordSet.Fields("distinguishedName").Value ' DN ermitteln

WScript.echo "Processing:" & count & ":" & strDN ' Diagnoseausgabe

proxyAddresses = objRecordSet.Fields("proxyAddresses").Value ' DN ermitteln

name = objRecordSet.Fields("distinguishedName").Value

For Each mail In proxyAddresses

If InStr(1,mail,"smtp",vbTextCompare) = 1 And InStr(name,"OU=Benutzer") > 0 Then

mail = Replace(Replace(mail,"SMTP:",""),"smtp:","")

uname = Replace(Left(name,InStr(name,",") - 1),"CN=","")

file.WriteLine(uname & ";" & mail)

total = total + 1

End If

Next

WScript.StdOut.Write "Processing:" & count & ":" & strDN ' Diagnoseausgabe

objRecordSet.MoveNext

Loop

file.Close

Set file= Nothing

Set fs = Nothing

WScript.echo "Anzahl der Objekte:"&count

WScript.echo "Mailadressen Total:"&total

AppendLog "Skript beendet", 4

WScript.quit(0)

Sub AppendLog(strLog, errlevel)

'F?gt einen Eintrag in die Log-Datei ein

Dim AppendLogfile

Dim AppendLogfs

If LogLevel>=errlevel Then

Set AppendLogfs = CreateObject("Scripting.FileSystemObject")

Set AppendLogfile = AppendLogfs.OpenTextFile(LogFile, 8, True)

AppendLogfile.Write(Now & ",")

Select Case errlevel

Case 1 AppendLogfile.Write("Fatal Line:" & Err.Source & ":")

Case 2 AppendLogfile.Write("Error:")

Case 3 AppendLogfile.Write("Warning:")

Case 4 AppendLogfile.Write("Information:")

Case 5 AppendLogfile.Write("Debug:")

Case Else AppendLogfile.Write("Code:"&errlevel)

End Select

AppendLogfile.WriteLine(","&strLog)

AppendLogfile.Close

End If

End Sub

Bearbeitet 13. April 2010 von Enno