Mit dem folgendem VBScript können die Mitglieder aller Gruppen in einer OU ausgelesen werden. Das Script generiert zu jeder Gruppe eine Textdatei mit den Mitgliedern.
' VBScript Document
' Read all groups with there members
Option Explicit
'Global variables
Dim WSHShell
Dim oContainer
Dim OutPutFile
Dim FileSystem
Dim oFile
Dim oGroup
Dim oPath
'Initialize global variables
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set FileSystem = WScript.CreateObject("Scripting.FileSystemObject")
' change the oPath to fit your AD structure'
oPath = "OU=DistributionLists,DC=DE,DC=domain,DC=com"
' for US oPath = "OU=Houston,DC=US,DC=domain,DC=com"
' for FR oPath = "OU=Internal,OU=ExchangeDL,DC=FR,DC=domain,DC=com"'
Set oContainer = GetObject("LDAP://" & oPath)
EnumerateContainers oContainer
Set FileSystem = Nothing
Set oContainer = Nothing
Set WSHShell = Nothing
'Say Finished when your done
'WScript.Echo "Finished"
WScript.Quit(0)
Sub EnumerateContainers(oContainer)
For Each oGroup In oContainer
Select Case LCase(oGroup.Class)
'If you find Groups
Case "group"
EnumerateGroups oGroup
Case "organizationalunit", "container"
EnumerateContainers oGroup
End Select
Next
End Sub
'List all Users
Sub EnumerateUsers(Cont)
Dim User
Dim uName
Dim uGName
Dim uMail
'Go through all Users and select them
For Each User In oGroup.Members
Select Case LCase(User.Class)
'If you find Users
Case "user", "contact", "group"
'Select all proxyAddresses
Dim Mail
If Not IsEmpty(User.Name) Then
uName = User.Name
End If
If Not IsEmpty(User.givenName) Then
uGName = User.givenName
End If
If Not IsEmpty(User.mail) Then
uMail = User.mail
End If
OutPutFile.WriteLine uName & "; " & uGName & ";" & uMail
Case "organizationalunit" , "container"
EnumerateUsers User
End Select
Next
End Sub
Sub EnumerateGroups(oGroup)
' write the members of the group in a text file
Set OutPutFile = FileSystem.CreateTextFile("C:\Group_" & oGroup.CN & ".txt", 1)
'Enumerate Container
Err.clear
EnumerateUsers oGroup
If (Err.number <> 0 ) then
wscript.echo Err.Number
wscript.quit
End if
'Clean up
OutPutFile.Close
End Sub
Das folgende VBScript liest alle Benutzer in einer angegebenen Active Directory OU aus und schreibt diese in eine Textdatei. Ausgelesen werden u.a. Vorname, Name, Telefonnummer, eMail
' ***************************************************
' This script list all users in the defined OU (Set oOU = ). And store the output
' to a file.
'
' ***************************************************
Dim oOU, oOU_Dublin, oOU_BNMobile, oOU_Student, oOU_Service, oOU_US, oOutPutFile, oFileSYS
Set oFileSYS = WScript.CreateObject("Scripting.FileSystemObject")
Set oOutPutFile = oFileSYS.CreateTextFile("C:\Useroutput.txt",True)
' set LDAP path to the OU that you will list
Set oOU = GetObject("LDAP://OU=Bonn,DC=DE,DC=domain,DC=com")
Set oOU_Dublin = GetObject("LDAP://OU=Dublin,OU=Bonn,DC=DE,DC=domain,DC=com")
Set oOU_BNMobile = GetObject("LDAP://OU=Mobile_BN,OU=Bonn,DC=DE,DC=domain,DC=com")
Set oOU_Student = GetObject("LDAP://OU=Students,OU=Bonn,DC=DE,DC=domain,DC=com")
Set oOU_Service = GetObject("LDAP://OU=Service accounts,OU=Bonn,DC=DE,DC=domain,DC=com")
' Houston
Set oOU_US = GetObject("LDAP://OU=Houston,DC=US,DC=domain,DC=com")
' call the Sub ListUsers with the LDAP Path that you have set above.
oOutPutFile.WriteLine "##### Bonn OU ##### "
ListUsers oOU
oOutPutFile.WriteLine "##### Bonn OU Dublin ##### "
ListUsers oOU_Dublin
oOutPutFile.WriteLine "##### Bonn OU Mobile ##### "
ListUsers oOU_BNMobile
oOutPutFile.WriteLine "##### Bonn OU Service Accounts ##### "
ListUsers oOU_Service
oOutPutFile.WriteLine "##### Bonn OU Students ##### "
ListUsers oOU_Student
oOutPutFile.WriteLine "##### Houston ##### "
ListUsers oOU_US
oOutPutFile.Close
Set oFileSYS = Nothing
Set oOU = Nothing
Set oOU_US = Nothing
WScript.Quit(0)
' SUB to list the users with the parameter oCount. oCount contain the LDAP Path (GetObject("LDAP://OU=...)
Sub ListUsers(oCount)
Dim oUSR
For Each oUSR In oCount
Select Case LCase(oUSR.Class)
Case "user"
If Not IsEmpty(oUSR.name) Then
oOutPutFile.WriteLine "Display Name: " & oUSR.Get ("name")
End If
If Not IsEmpty(oUSR.title) Then
oOutPutFile.WriteLine "Title: " & oUSR.Get ("title")
End If
If Not IsEmpty(oUSR.sn) Then
oOutPutFile.WriteLine "Name: " & oUSR.Get ("sn")
End If
If Not IsEmpty(oUSR.givenName) Then
oOutPutFile.WriteLine "given Name: " & oUSR.Get ("givenName")
End If
If Not IsEmpty(oUSR.description) Then
oOutPutFile.WriteLine "description: " & oUSR.Get ("description")
End If
If Not IsEmpty(oUSR.telephoneNumber) Then
oOutPutFile.WriteLine "Telephone: " & oUSR.Get ("telephoneNumber")
End If
If Not IsEmpty(oUSR.mobile) Then
oOutPutFile.WriteLine "Cell Phone: " & oUSR.Get ("mobile")
End If
If Not IsEmpty(oUSR.facsimileTelephoneNumber) Then
oOutPutFile.WriteLine "Fax: " & oUSR.Get ("facsimileTelephoneNumber")
End If
If Not IsEmpty(oUSR.mail) Then
oOutPutFile.WriteLine "eMail: " & oUSR.Get ("mail")
End If
oOutPutFile.WriteLine "______________________________________"
End Select
Next
End Sub
Mit dem folgendem VBScript können die Mitglieder einer, im Script angegebenen, OU in eine Excel List eingelesen werden. Inklusive aller SMTP eMail Adressen.
' List Active Directory User Data in a Spreadsheet
' include all SMTP and smtp eMail addresses
' On Error Resume Next
Public x, m
Dim oOU, oOU_Dublin, oOU_Service, oOU_HOU, oOU_FR
'Const ADS_SCOPE_SUBTREE = 2
Const ADS_UF_ACCOUNTDISABLE = 2
' create the Excel worksheet and add the first row with caption
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
' column titles for the Excel sheet
objExcel.Cells(1, 1).Value = "First name"
objExcel.Cells(1, 2).Value = "Last name"
objExcel.Cells(1, 3).Value = "Title"
objExcel.Cells(1, 4).Value = "Department"
objExcel.Cells(1, 5).Value = "Phone number"
objExcel.Cells(1, 6).Value = "Phone number 2"
objExcel.Cells(1, 7).Value = "Mobile number"
objExcel.Cells(1, 8).Value = "eMail Address"
objExcel.Cells(1, 9).Value = "eMail Address 2"
' set LDAP path to the OU that you will list in the Excel sheet
Set oOU = GetObject("LDAP://OU=BN,DC=DE,DC=Domain,DC=com")
Set oOU_UK = GetObject("LDAP://OU=UK,DC=DE,DC=Domain,DC=com")
Set oOU_Dublin = GetObject("LDAP://OU=Dublin,OU=BN,DC=DE,DC=Domain,DC=com")
Set oOU_Student = GetObject("LDAP://OU=Students,OU=BN,DC=DE,DC=Domain,DC=com")
Set oOU_HOU = GetObject("LDAP://OU=_Users,DC=US,DC=Domain,DC=com")
Set oOU_FR = GetObject("LDAP://OU=employees,OU=Users,OU=* Resources,DC=FR,DC=Domain,DC=com")
x = 2 ' initialize counter for the Excel rows
' assign caption and calling Sub ListUsers for DE
objExcel.Cells(x, 1).Value = "DE ############"
x = x +1
ListUsers oOU
ListUsers oOU_UK
ListUsers oOU_Dublin
ListUsers oOU_Student
' assign caption and calling Sub ListUsers for US
objExcel.Cells(x, 1).Value = "US users ###########"
x = x +1
ListUsers oOU_HOU
' assign caption and calling Sub ListUsers for FR
objExcel.Cells(x, 1).Value = "FR users ###########"
x = x +1
ListUsers oOU_FR
Sub ListUsers(oOUName)
Dim oUSR
For Each oUSR In oOUName
Select Case LCase(oUSR.Class)
Case "user"
If Not IsEmpty(oUSR.GivenName) Then
objExcel.Cells(x, 1).Value = oUSR.GivenName
End If
If Not IsEmpty(oUSR.SN) Then
'Lastname = oUSR.SN
'WScript.Echo Lastname
objExcel.Cells(x, 2).Value = oUSR.SN
End If
If Not IsEmpty(oUSR.title) Then
objExcel.Cells(x, 3).Value = oUSR.title
End If
If Not IsEmpty(oUSR.Department) Then
objExcel.Cells(x, 4).Value = oUSR.Department
End If
If Not IsEmpty(oUSR.telephonenumber) Then
objExcel.Cells(x, 5).Value = oUSR.telephonenumber
End If
If Not IsEmpty(oUSR.otherTelephone) Then
objExcel.Cells(x, 6).Value = oUSR.otherTelephone
End If
If Not IsEmpty(oUSR.mobile) Then
objExcel.Cells(x, 7).Value = oUSR.mobile
End If
If Not IsEmpty(oUSR.mail) Then
objExcel.Cells(x, 8).Value = oUSR.mail
End If
' list all smtp proxy addresses'
If Not IsEmpty(oUSR.proxyAddresses) Then
m = 0
For Each proxemail In oUSR.proxyAddresses
If Left(proxemail, 4) = "smtp" Then
objExcel.Cells(x, 9+m).Value = Mid (proxemail, 6)
m = m + 1
End If
Next
End If
x = x + 1
End Select
Next
End Sub
Set objRange = objExcel.Range("A1","I1")
objRange.Font.Size = 12
objRange.Font.Bold = "true"
Set objRange = objExcel.Range("A1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
Set objRange = objExcel.Range("B1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
Set objRange = objExcel.Range("C1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
Set objRange = objExcel.Range("D1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
Set objRange = objExcel.Range("E1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
Set objRange = objExcel.Range("F1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
Set objRange = objExcel.Range("G1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
Set objRange = objExcel.Range("H1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
Set objRange = objExcel.Range("I1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
Das folgende VBScript liest alle Computerkonten im Active Directory aus und schreibt diese in eine Textdatei. Es werden alle, im AD angelegten, Computerkonten ausgelesen, es erfolgt keine Prüfung ob das Computerkonto physikalisch oder virtuell existiert.
Dim RootDSE, DomainNC, Connection, Command, RecordSet
Set oFileSYS = WScript.CreateObject("Scripting.FileSystemObject")
Set oOutPutFile = oFileSYS.CreateTextFile("C:\ServerList.txt",True)
Set RootDSE = GetObject("LDAP://rootDSE")
DomainNC = RootDSE.Get("defaultNamingContext")
Set Connection = CreateObject("ADODB.Connection")
Connection.Open("Provider=ADsDSOObject;")
Set Command = CreateObject("ADODB.Command")
Command.ActiveConnection = Connection
Command.CommandText = "LDAP://" & DomainNC & ";(objectCategory=Computer);CN;subtree"
' Properties setzen
Command.Properties("Cache Results") = False
Command.Properties("Page Size") = 100
Command.Properties("Sort On") = "CN"
Command.Properties("Timeout") = 30
Set RecordSet = Command.Execute()
' Auflisten der Computer
Do While Not RecordSet.EOF
oOutPutFile.WriteLine RecordSet.Fields("CN").Value
RecordSet.MoveNext()
Loop
Connection.Close()
TOP Hierzu wir für die Route einfach einen Eintrag in die Regestrie des Rechners eingetragen.
Windows speichert die Einträge für die permanenten Routen in der Registrie unterhalb von
HKLM\YSTEM\CurrentControlSet\Services\Tcpip\Parameters\PersistentRoutes und für jede Route gibt es eine Eintrag.
' set registry hive
Const HKEY_LOCAL_MACHINE = &H80000002
' open text file with the computer names
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile("ServerList.txt", 1)
' set registry key for the persistend route for all server in the text file
Do Until objTextFile.AtEndofStream
strComputer = objTextFile.Readline
' strComputer = "." ' Punkt = lokaler Rechner
Set oReg=GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = "SYSTEM\CurrentControlSet\Services\Tcpip\Parameters\PersistentRoutes"
strValueName = "10.66.66.100,255.255.255.255,192.168.168.3,1"
strValue = ""
oReg.SetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
Loop
TOP Das folgende VBScript ändert den Serverpfad und den Laufwerksbuchstaben aller Benutzer in einer angegebenen OU
On Error Resume Next
'Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "SELECT sAMAccountName,cn FROM " & "'LDAP://OU=employees,DC=DE,DC=domain,DC=com'" & "WHERE objectCategory='User'"
objCommand.Properties("Page Size") = 1000
'objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
' set homedir for all user in the OU
Do Until objRecordSet.EOF
' assign the user CN for the actual user
Set objUser = GetObject("LDAP://cn=" & objRecordSet.Fields("cn").Value & ",OU=employees,DC=DE,DC=domain,DC=com")
' Set objUser = GetObject("LDAP://cn=testuser,OU=TestOU,DC=DE,DC=domain,DC=com")
strUser = objRecordSet.Fields("sAMAccountName").Value
strHomeDirectory = "\\servername\homefolder\" & strUser
objUser.put "homeDirectory", strHomeDirectory
objUser.put "homeDrive", "H:"
objUser.SetInfo ' set the
' for test purpose to display
WScript.Echo strHomeDirectory & " , " & objRecordSet.Fields("sAMAccountName").Value
objRecordSet.MoveNext
Loop