27. April 2005, 14:43 Uhr 
Kategorie: 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)
