2
Active Directory - alle EMailadressen in Datei ausgeben
Hi,
aufgrund der Komplexität habe ich die Umsetzung angepasst.
Es geht nun darum alle Mailadressen der Domäne, also von Benutzern, Gruppen etc. auszulesen und in eine Datei zu schreiben (wenn möglich nur bis zum @ Zeichen).
Das auslesen des Namens und der DN funktioniert auch, Problem hier ist nur das, sobald ich bei "Do Until" "Mail" ausgeben möchte (also auch die Mailadresse) sagt er:
Error: Type mismatch: 'WriteLine'
Code: 800A000D
Sorce: Microsoft VBScript runtime error
Hier der Code:
Const ADS_SCOPE_SUBTREE = 5
Dim fso, file
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.CreateTextFile("n:\ausgabe.txt", True)
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = "SELECT distinguishedname,mail,name FROM 'LDAP://DC=www,DC=domain,DC=de'WHERE objectCategory='user'" & _
"OR objectCategory='group'"
Set objRecordSet = objCommand.Execute
Do Until objRecordSet.EOF
file.WriteLine(objRecordSet.Fields("distinguishedname"))
file.WriteLine(objRecordSet.Fields("mail"))
file.WriteLine(objRecordSet.Fields("name"))
objRecordSet.MoveNext
Loop
aufgrund der Komplexität habe ich die Umsetzung angepasst.
Es geht nun darum alle Mailadressen der Domäne, also von Benutzern, Gruppen etc. auszulesen und in eine Datei zu schreiben (wenn möglich nur bis zum @ Zeichen).
Das auslesen des Namens und der DN funktioniert auch, Problem hier ist nur das, sobald ich bei "Do Until" "Mail" ausgeben möchte (also auch die Mailadresse) sagt er:
Error: Type mismatch: 'WriteLine'
Code: 800A000D
Sorce: Microsoft VBScript runtime error
Hier der Code:
Const ADS_SCOPE_SUBTREE = 5
Dim fso, file
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.CreateTextFile("n:\ausgabe.txt", True)
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = "SELECT distinguishedname,mail,name FROM 'LDAP://DC=www,DC=domain,DC=de'WHERE objectCategory='user'" & _
"OR objectCategory='group'"
Set objRecordSet = objCommand.Execute
Do Until objRecordSet.EOF
file.WriteLine(objRecordSet.Fields("distinguishedname"))
file.WriteLine(objRecordSet.Fields("mail"))
file.WriteLine(objRecordSet.Fields("name"))
objRecordSet.MoveNext
Loop
Share on Facebook
Share on Twitter
Share on Reddit
Share on LinkedinPlease also mark the comments that contributed to the solution of the article
Content-Key: 74893
Url: https://administrator.de/contentid/74893
Printed on: April 18, 2024 at 05:04 o'clock
2 Comments
Latest comment
Hallo Breede,
ich habe leider nur den Tip, die dem jeweiligen System bekannten SMTP-Adressen auszulesen, vielleicht hilft es trotzdem:
http://www.msexchangefaq.de/code/smtplist.htm
Grüße, Steffen
ich habe leider nur den Tip, die dem jeweiligen System bekannten SMTP-Adressen auszulesen, vielleicht hilft es trotzdem:
http://www.msexchangefaq.de/code/smtplist.htm
Grüße, Steffen
Hier die Lösung:
Noch etwas zur Erklärung.
Erst hole ich alle Attribute aus dem LDAP die eine Mail Adresse enthalten können.
Mailadresse : mail
Weitere Mailadressen: proxyAddresses
Mailbox: othermailbox
Diese gebe ich dann in eine Datei aus, da aber viele Objekte die eine Mail Adresse haben könnten keine haben, entstehen viele Leerzeilen. Diese werden mit der Prozedur "Leerzeilen" entfernt.
Um das ganze lesbarer zu machen, habe ich zusätzlich alles ab dem @ mit dem Replace entfernt.
Nun liegen alle Mailadressen der Domäne, alphabetisch sortiert und ohne Leerzeilen in einer Datei.
Noch etwas zur Erklärung.
Erst hole ich alle Attribute aus dem LDAP die eine Mail Adresse enthalten können.
Mailadresse : mail
Weitere Mailadressen: proxyAddresses
Mailbox: othermailbox
Diese gebe ich dann in eine Datei aus, da aber viele Objekte die eine Mail Adresse haben könnten keine haben, entstehen viele Leerzeilen. Diese werden mit der Prozedur "Leerzeilen" entfernt.
Um das ganze lesbarer zu machen, habe ich zusätzlich alles ab dem @ mit dem Replace entfernt.
Nun liegen alle Mailadressen der Domäne, alphabetisch sortiert und ohne Leerzeilen in einer Datei.
''''' Konstanten '''''
Const ADS_SCOPE_SUBTREE = 5
''''' Variablen '''''
Dim fso
Dim strRecordsetInhalt
Dim File_SAC_Input
Dim File_SAC
Set fso = CreateObject("Scripting.FileSystemObject")
Set File_SAC_Input = fso.CreateTextFile("N:\SAC_Input.txt", True)
Set File_SAC = fso.CreateTextFile("N:\SAC.txt", True)
''''' Verbindung zum Active Directory '''''
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open("Active Directory Provider")
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
''''' Abfrage und Ausgabe per SQL über LDAP '''''
objCommand.CommandText = " SELECT mail, othermailbox, proxyAddresses " & _
" FROM 'LDAP://DC=www,DC=xxx,DC=de' " & _
" WHERE mail <> '@' " & _
" ORDER BY mail "
' Ohne WHERE konnte kein ORDER BY angesprochen werden
Set objRecordSet = objCommand.Execute
Do Until objRecordSet.EOF
strRecordsetInhalt = Trim(objRecordSet.GetString(2, , VbCrLf,VbCrLf,""))
strRecordsetInhalt = UCase(strRecordsetInhalt)
strRecordsetInhalt = Replace(strRecordsetInhalt,"@WWW.XXX.DE","")
File_SAC_Input.WriteLine(strRecordsetInhalt)
If not objRecordSet.EOF Or objRecordSet.BOF Then
objRecordSet.MoveNext
' MoveNext bei objRecordSet.EOF verursacht einen Fehler
End If
Loop
File_SAC_Input.Close
Call Leerzeichen
''''' Sub Routinen '''''
Sub Leerzeichen
''''' Alle Leerzeilen werden entfernt
'''''
''''' Quelle mit Leerzeilen: "Open_SAC_Input"
''''' Ziel ohne Leerzeilen : "File_SAC"
''''' Variablen '''''
Dim sLine
Set Open_SAC_Input = fso.OpenTextFile("N:\SAC_Input.txt", 1, True)
''''' Entfernen der Leerzeilen '''''
Do Until Open_SAC_Input.AtEndOfStream
sLine = Open_SAC_Input.ReadLine
If Trim(sLine) <> "" Then
File_SAC.WriteLine(sLine)
End If
Loop
File_SAC.Close
End Sub
