von postNils Kaczenski post27. April 2005, 14:43 Uhr
post Kategorie: AD: Erweiterte Abfragen, Exchange

Um gezielt nach einer bestimmten Mailadresse im AD zu suchen, eignet sich das folgende Skript. Es fragt nach einem Fragment, das in einer Adresse vorkommen soll (z.B. "support" oder "@unserefirma") und gibt alle Adressen und die zugeordneten Objekte (Benutzer, Gruppen usw.) aus, die dieses Fragment enthalten.

Dies ist die korrigierte Fassung: Sie funktioniert ab sofort in jeder Domäne, nicht nur bei mir in der Firma. ,-) Voraussetzung ist, dass der aufrufende Rechner Domänenmitglied ist.

Wer zur Übersicht alle Mailadressen ausgeben will, nutzt das Skript aus diesem Artikel.

""""""""""""""""""""""""""'
' AD-Mailadressen_suchen.vbs
' Beschreibung
'
' Version: 1.1a
' Datum: 27.04.2005/23.8.2005
' Autor: Nils Kaczenski (Vorname at Nachname .de)
' Letzte Änderungen:
'
' Nils Kaczenski stellt dieses Skript ohne jede
' Gewährleistung zur Verfügung.
' Die Verwendung geschieht auf eigene Gefahr.
'
""""""""""""""""""""""""""'

Option Explicit
Dim
strSuchstring '
Dim strMail '
Dim arrMember '
Dim arrObjectClass '
Dim arrProxyAddresses '
Dim i '
Dim objConn '
Dim objExplorer '
Dim objRSAD '
Dim objRSlokal '
Dim strAusgabe '
Dim strConn '
Dim strMember '
Dim strObjectClass '
Dim strSQL 'Dim objRootDim strDomain

Set objConn = CreateObject("ADODB.Connection")
Set objRSlokal = CreateObject("ADODB.Recordset")

strSuchstring = InputBox("Wonach wird in der Mailadresse gesucht?", _
"Mailadresse suchen")

' Domänenzugriff …
set objRoot = GetObject("LDAP://rootDSE")
strDomain = objRoot.Get("DefaultNamingContext")

' Datenbankzugriff …
strConn = "Provider=ADsDSOObject;"
objConn.Open strConn

' Zugriff auf die gesamte Tabelle
strSQL = "SELECT name,mailNickname,mail,proxyAddresses,member,objectClass " _
& "FROM 'LDAP://" & strDomain & "' WHERE proxyAddresses='*" _
& strSuchstring & "*'"
Set objRSAD = objConn.Execute(strSQL)

' lokales Recordset zur Anzeige definieren
objRSlokal.Fields.Append "Mailadresse", 202, 255
objRSlokal.Fields.Append "Name", 202, 255
objRSlokal.Fields.Append "Alias", 202, 255
objRSlokal.Fields.Append "Typ", 202, 255
objRSlokal.Fields.Append "Mitglieder", 202, 16384

objRSlokal.Open

Do Until objRSAD.EOF
arrProxyAddresses = objRSAD("proxyAddresses")
strMail = objRSAD("mail")
If Not IsNull(objRSAD("member")) Then
arrMember = objRSAD("member")
strMember = Join(arrMember, "<br>")
Else
strMember = ""
End If
arrObjectClass = objRSAD("objectClass")
strObjectClass = arrObjectClass(UBound(arrObjectClass))
For i=0 To UBound(arrProxyAddresses)
If (InStr(LCase(arrProxyAddresses(i)), LCase(strSuchstring)) <> 0 _
AND LCase(Left(arrProxyAddresses(i),5)) = "smtp:") Then
' Neuen Datensatz lokal einfügen
objRSlokal.AddNew
objRSlokal("Name") = objRSAD("name")
objRSlokal("Alias") = objRSAD("mailNickname")
objRSlokal("Typ") = strObjectClass
objRSlokal("Mailadresse") = Mid(arrProxyAddresses(i),6)
objRSlokal("Mitglieder") = strMember
objRSlokal.Update
End If
Next
objRSAD.MoveNext
Loop

If Not objRSlokal.EOF Then
objRSlokal.Sort="Mailadresse"
objRSlokal.MoveFirst
strAusgabe = objRSlokal.GetString(2, -1, "</TD><TD>", "</TD></TR>" _ & vbCrLf & "<TR><TD>", " ")
strAusgabe = "<HTML><BODY style=""font-family:sans-serif;"">" _
& "<H1>Mailadressen mit dem Inhalt " & strSuchstring & "</H1>" _
& "<TABLE border=""1""><TR><TD>" _
& strAusgabe & "</TD></TR></TABLE></BODY></HTML>"
Else
strAusgabe = "<HTML><BODY style=""font-family:sans-serif;"">" _
& "<p>Die Suche nach Mailadressen mit dem Inhalt " _
& strSuchstring & " hatte kein Ergebnis.</p>" _
& "</BODY></HTML>"
End If

Set objExplorer = CreateObject("InternetExplorer.Application")
objExplorer.Navigate "about:blank"
objExplorer.ToolBar = 0
objExplorer.StatusBar = 0
objExplorer.Width=500
objExplorer.Height = 400
objExplorer.Left = 0
objExplorer.Top = 0
objExplorer.Visible = 1
objExplorer.document.writeln(strAusgabe)