Archiv der Kategorie: VBScript

Script, um für alle User einer OU den Haken „Kennwort läuft nie ab“ zu setzen

Auch wenn es ein Sicherheitsrisiko darstellt, ist es doch in manchen Umgebungen auf Grund der dort vorhandenen User nötig, Useraccounts so zu konfigurieren, dass das Passwort nie abläuft.

Neben der Möglichkeit, dies über Gruppenrichtlinien abzuarbeiten kann dies natürlich auch per Script geschehen…

Anbei ein VBScript, das die gewünschten Änderungen vornimmt.

Vorgangsweise:
Script als „PasswordNeverExpires.vbs“ auf einem beliebigen Client speichern, Zeile 12 an die gewünschte OU an passen und laufen lassen.
Hinweis: es wird ein Logfile erstellt, das Auskunft über die Änderungen gibt.

'###########################################################################
'# Usage:
'#  als    PasswordNeverExpires.vbs      an beliebiger Stelle auf einem Client speichern
'#
'# Variablen, die geändert werden MÜSSEN
'# ACHTUNG: strOU ist in 'verkehrter' Reihenfolge, dh:
'# strOU = "OU=1A,OU=Schueler,OU=benutzer," steht für alle User,
'# die in der OU=1A sind, die wiederum in der OU=Schueler sind, und diese dann in der OU Benutzer liegt
'# also:
'#
'# Benutzer
'# |__ Schueler
'#    |___ 1A
'#
'# Hier findest Du zusätzliche Infos zu LDAP-Attributen:
'# http://www.computerperformance.co.uk/Logon/LDAP_attributes_active_directory.htm
  
strOU = "OU=1A,OU=Schueler,OU=Benutzer,"   'ACHTUNG auf den Beistrich!!
 
  
'# Ab hier nur mehr für Auskenner veränderbar...
'############################################################################
on error resume next
Dim rootDSE, domainObject
Set rootDSE = GetObject("LDAP://RootDSE")
domainContainer = rootDSE.Get("defaultNamingContext")
Set domainObject = GetObject("LDAP://" & strOU & domainContainer)
  
Set fs = CreateObject ("Scripting.FileSystemObject")
Set outFile = fs.CreateTextFile (".\logfile_ADKonten.txt")
  
exportUsers(domainObject)
  
Set oDomain = Nothing
  
Sub ExportUsers(oObject)
on error resume next
   Dim oUser
   For Each oUser in oObject
      Select Case oUser.Class
         Case "user"
  
            call changeIT(oUser.distinguishedName)
  
         Case "organizationalUnit" , "container"
  
            ExportUsers(oUser)
      End select
   Next
End Sub
  
  

 
sub changeIT(myUser)
'On Error Resume Next
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Set objUser = GetObject("LDAP://" & myuser)

intUserAccountControl = objUser.Get("userAccountControl")
 

        ' Check if "Password Never Expires" already set.
        If Not objUser.userAccountControl AND ADS_UF_DONT_EXPIRE_PASSWD Then
            ' Set bit for "Password Never Expires".
			objUser.Put "userAccountControl", _
			objUser.userAccountControl XOR ADS_UF_DONT_EXPIRE_PASSWD
			
            objUser.SetInfo    
            outfile.WriteLine  myUser & " wurde erfolgreich geaendert!"
        End If
 
end Sub
WScript.Quit

User per VBScript aus dem AD in eine .csv exportieren für MAHARA-Import

Der Massenimport via .csv von Usern in MAHARA ist (vor allem, wenn man auf das deutsche Language-Pack umgestellt hat) voll der Pein und Trauer…

Anbei ein Script, dass ausgewählte Schüler anhand ihrer Mitgliedschaft zu einer OU in einer CommandShell ausgibt, die man dann nur noch kopieren muss in eine .csv und importieren…

Speicher als „maharaExport.vbs“ und in einer Commandshell mit
cscript maharaExport.vbs
ausführen lassen…

'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.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 

'### hier die gewünschte OU auswählen ######
course = "3A,3B,3C,3D,3E"

courseArr = split(course,",")

'Wscript.Echo "Benutzername;Passwort;E-Mail;Vorname;Nachname;Studenten-ID"
Wscript.Echo "username,password,email,firstname,lastname,studentid"
UserCounter = 20170001

for i = 0 to UBOUND(courseArr)
	objCommand.CommandText = "SELECT name, distinguishedName, sAmAccountname, mail, givenName, SN FROM 'LDAP://OU=" & courseArr(i) & ",OU=Schueler,OU=Benutzer,DC=hak-neusiedl,DC=local' WHERE objectCategory='user'"

	Set objRecordSet = objCommand.Execute

	objRecordSet.MoveFirst

	Do Until objRecordSet.EOF

		Wscript.Echo  chr(34) & objRecordSet.Fields("sAmAccountname").Value & chr(34) & "," & chr(34) & "ASDFASDF" & chr(34) & "," & chr(34) & objRecordSet.Fields("mail").Value & chr(34) & "," & chr(34) & objRecordSet.Fields("givenName").Value & chr(34) & "," & chr(34) & objRecordSet.Fields("SN").Value & chr(34) & "," & chr(34) & UserCounter & chr(34) '& "," & courseArr(i)

		objRecordSet.MoveNext
		UserCounter = UserCounter+1
	Loop

next

per VBScript MailAttribute aus den UserAccounts entfernen

Es war einmal ein Exchange – der dann abgedreht wurde – und die User wurden dann auf Gmail umgesiedelt.

Das lief prima – bis die User auf den Hosted Exchange von OFFICE365 migriert werden sollten… (und es ja onPrime keinen Exchange mehr gab)…

Das folgende Script hat diese Einträge für alle User einer bestimmten OU entfernt – seither klappts mit der Migration wie am Schnürchen…
Als ExchangeAttributeDelete.vbs speichern und direkt am Domänencontroller starten (nach Anpassung an die eigene Domain!)

On Error Resume Next
Const ADS_SCOPE_SUBTREE = 2

Const ADS_PROPERTY_APPEND = 3
Const ADS_PROPERTY_DELETE = 4
Const ADS_PROPERTY_CLEAR = 1 

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 legacyExchangeDN, name, distinguishedName, sAmAccountname, proxyaddresses FROM 'LDAP://OU=lehrer,OU=Benutzer,DC=gymnasium,DC=at' WHERE objectCategory='user'"

Set objRecordSet = objCommand.Execute

objRecordSet.MoveFirst

Do Until objRecordSet.EOF

    'Wscript.Echo objRecordSet.Fields("distinguishedName").Value
	if len(objRecordSet.Fields("legacyExchangeDN").Value)>= 1  THEN
	Wscript.Echo objRecordSet.Fields("sAmAccountname").Value & " -- " & objRecordSet.Fields("Name").Value

	'# falls man das Script nur für einen User testen möchte:  (ACHTUNG: zweites END IF unten einkommentieren)
	'if objRecordSet.Fields("name").Value = "WUT" then
	'Wscript.Echo objRecordSet.Fields("name").Value

	Set objUser = GetObject("LDAP://" & objRecordSet.Fields("distinguishedName").Value)

	Wscript.Echo objRecordSet.Fields("legacyExchangeDN").Value
	wscript.echo len(objRecordSet.Fields("legacyExchangeDN").Value)

			objUser.PutEx ADS_PROPERTY_CLEAR, "msExchHomeServerName", 0
			objUser.SetInfo

			objUser.PutEx ADS_PROPERTY_CLEAR, "legacyExchangeDN", 0
			objUser.SetInfo

			objUser.PutEx ADS_PROPERTY_CLEAR, "homeMDB", 0
			objUser.SetInfo

			objUser.PutEx ADS_PROPERTY_CLEAR, "homeMTA", 0
			objUser.SetInfo

			objUser.PutEx ADS_PROPERTY_CLEAR, "mDBUseDefaults", 0
			objUser.SetInfo

			objUser.PutEx ADS_PROPERTY_CLEAR, "msExchALObjectVersion", 0
			objUser.SetInfo

			objUser.PutEx ADS_PROPERTY_CLEAR, "msExchMailboxGuid", 0
			objUser.SetInfo

			objUser.PutEx ADS_PROPERTY_CLEAR, "msExchMailboxSecurityDescriptor", 0
			objUser.SetInfo

			objUser.PutEx ADS_PROPERTY_CLEAR, "msExchPoliciesIncluded", 0
			objUser.SetInfo

			objUser.PutEx ADS_PROPERTY_CLEAR, "msExchUserAccountControl", 0
			objUser.SetInfo

			objUser.PutEx ADS_PROPERTY_CLEAR, "msNPAllowDialin", 0
			objUser.SetInfo

			objUser.PutEx ADS_PROPERTY_CLEAR, "ShowInAddressBook", 0
			objUser.SetInfo

			objUser.PutEx ADS_PROPERTY_CLEAR, "textEncodedORAddress", 0
			objUser.SetInfo

			wscript.Echo "erfolgreiche geloescht!" & vbcrlf

	'end if
	end if

    objRecordSet.MoveNext

Loop

per VBScript Einträge im AD aus dem Attribut ProxyAddresses entfernen

Es kann vorkommen, dass in historisch gewachsenen Domänen einzelne (oder alle) User Einträge im AD-Attribut „ProxyAddresses“ haben, die auf einen alten Exchange / Gmail / etc hinweisen.

Dies ist äußerst hinderlich, wenn man diese Benutzer per Azure AD Connect ins OFFICE 365 übertragen möchte, da dieser Eintrag dazu führt, dass Benutzer kein Outlook-Konto in OFFICE365 bekommen.

Die Fehlermeldung lautet dann:

Mailfehler

 
 
 
 
Benutzername       xyz@domain.at    E-Mail-Adresse  Aliase   Anzeigen nicht möglich. Versuchen Sie es noch mal.
 

Die Lösung ist es nun, die Einträge im Attribut „ProxyAddresses“ zu entfernen, was folgendes Script massenhaft erledigen kann:
(als MassenAttributlöscher.vbs speichern und direkt am Domänencontroller ausführen)

On Error Resume Next
Const ADS_SCOPE_SUBTREE = 2
Const ADS_PROPERTY_APPEND = 3
Const ADS_PROPERTY_DELETE = 4
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 name, distinguishedName, sAmAccountname, proxyaddresses FROM 'LDAP://OU=lehrer,OU=Benutzer,DC=gymnasium,DC=at' WHERE objectCategory='user'"

Set objRecordSet = objCommand.Execute

objRecordSet.MoveFirst

Do Until objRecordSet.EOF

    'Wscript.Echo objRecordSet.Fields("distinguishedName").Value
	if NOT objRecordSet.Fields("proxyaddresses").Value = NULL THEN
	Wscript.Echo objRecordSet.Fields("sAmAccountname").Value & " -- " & objRecordSet.Fields("Name").Value

	'# falls man das Script nur für einen User testen möchte:  (ACHTUNG: zweites END IF unten einkommentieren)
	'if objRecordSet.Fields("name").Value = "DRE" then
	'Wscript.Echo objRecordSet.Fields("name").Value

	arrProxyAddresses = objRecordSet.Fields("proxyAddresses").Value
	Set objUser = GetObject("LDAP://" & objRecordSet.Fields("distinguishedName").Value)

	'### zum Löschen aller Einträge in ProxyAddresses folgendes einkommentieren:
	For Each objItem In arrProxyAddresses

					objUser.PutEx ADS_PROPERTY_DELETE, "proxyAddresses", Array(objItem)
					objUser.SetInfo

	Next

	'### zum Einfügen einer zusätzlichen Adresse folgendes einkommentieren:

				' objUser.PutEx ADS_PROPERTY_APPEND, "proxyAddresses", Array("smtp:" & objRecordSet.Fields("sAmAccountname").Value & "@brg-mattersburg.at" )
				 'objUser.SetInfo

	'### zum Auflisten aller Einträge in ProxyAddresses folgendes einkommentieren:
	For x=0 to UBOUND(arrProxyAddresses)
		wscript.echo arrProxyAddresses(x)

	Next

			wscript.Echo "erfolgreiche gelöscht!" & vbcrlf

	end if
	'end if

    objRecordSet.MoveNext

Loop

Problem: Classic ASP + IIS 7 + Microsoft Access Driver (*.mdb)

Bei der Migration von klassischen ASP-Anwendungen (.asp) auf einen IIS 7 (zb 2008 R2) kann (bzw. wird) es zu Problemen kommen, falls via ASP auf eine alte Access-DB zugegriffen wird.

Der Code dafür könnte zb so aussehen:

<%
set conn=server.createobject(„adodb.connection“)
‚ DSNlose Verbindung zu einer MS Access Datenbank
DSNtemp=“DRIVER={Microsoft Access Driver (*.mdb)}; „
DSNtemp=dsntemp & „DBQ=“ & server.mappath(„db1.mdb“)
conn.Open DSNtemp
%>

Obiger Code führt grundsätzlich zu KEINER Fehlermeldung, sondern zu einem allgemeinen Hinweis („An Error occurred…“), dass etwas mit den Code nicht stimmt…

Um detaillierte Fehlermeldungen zu aktivieren, muss man für den jeweilgen Ordner, in dem sich die Website befindet, folgendes aktivieren:

1.) Ordner auswählen
2.) auf das Icon „ASP“ doppelklicken (falls nicht vorhanden, muss dieses nachinstalliert werden)
3.)

detaillierteFehlermeldung
Nun bekommt man eine detaillierte Fehlermeldung, die wie folgt lautet:

Microsoft OLE DB Provider for ODBC Drivers error ‚80004005‘
[Microsoft][ODBC Driver Manager] Data source name not found and no default driver specified

Die Ursachen hierfür sind:
1.) per default hat der IUSR (anonyme Internetuser) KEINEN Zugriff auf die Datenbank
2.) die Datenbankverbindung wird über den 64-bit Treiber hergestellt – und funktioniert daher nicht mehr…

Lösung:
1.) im Windows Explorer auf die .mdb dem IUSR  Schreibrechte einräumen (besser noch für den gesamten Ordner, in dem die DB liegt, da beim Öffnen auch eine .ldb angelegt wird)

2.) im DefaultAppPool 32-bit-Anwendungen aktivieren

32bitAktivieren
Nicht vergessen: den IIS nach der Aktion einen Neustart gönnen…

Am Code muss danach nichts geändert werden!

 

 

Besitzer und Sicherheitseinstellungen von Ordnern im AD per Skript ändern

Es ist durchaus üblich, dass das Home Directory und der Username in einer Windows Active Directory Domäne ident sind.

Dies kann man dazu nützen, dass man die Berechtigungen automatisiert für diese Ordner neu setzt.

[Das Script hab ich schnell zusammengebastelt/googelt, weil ich bei einem Kunden eine Struktur vorgefunden habe, die dadurch zu einer Katastrophe wurde, dass einerseits Berechtigungen vererbt wurden, andererseits JEDER Vollzugriff hatte und dergleichen mehr…]

Verwendung:
als ChangeBerechtigungen.vbs speichern und dann aus einer command-shell heraus wie folgt starten:

cscript ChangeBerechtigungen.vbs /scharf:[no/yes] /Userordner:\\server\share\home$

Der Flag /scharf lässt einen das Script ohne echte Aktivität einmal ausprobieren…

Was passiert während der Abarbeitung:
es wird für jeden Ordner im angegebenen Userordner geprüft, ob es einen User im AD gibt, der den selben Namen trägt.
Wenn ein User existiert,
– übernimmt die Gruppe der Administratoren den Besitz
– erhält die Gruppe der Administratoren Vollzugriff, der betreffende User darf Ändern
– der betreffende User wird neuer Besitzer des Ordners
Dies alles wird nach unten hin vererbt, sodass danach die Rechte auf den entsprechenden Ordner und alle Unterordner wieder passen sollten.

Ich habe das Script soeben mit 800 Usern getestet und bin ziemlich happy 😉

WICHTIG: Das Script wurde nur unter Windows 7 getestet!!! Ich kann nicht versprechen, ob es auf einem anderen OS läuft!

warntext = warntext & "Dieses Tool verändert den Besitzer von Ordnern und Dateien!" & vbcrlf
warntext = warntext & "Funktionsweise: Es wird für jeden Ordner und Unterordner im Active Directory ""nachgesehen"", ob es einen User" & vbcrlf
warntext = warntext & "mit dem selben Namen gibt!" & vbcrlf
warntext = warntext & "Wenn es eine Übereinstimmung gibt, so wird bei alle Dateien sowie Ordnern in diesem Verzeichnis der Besitzer geändert" & vbcrlf
warntext = warntext & "" & vbcrlf
warntext = warntext & "ACHTUNG! Es werden aktuell hier nur die Ordner aufgelistet." & vbcrlf
warntext = warntext & "Um in den Ordnern die Besitzer tatsächlich zu ändern (nachdem alles kontrolliert wurde), MUSS dieses Script " & vbcrlf
warntext = warntext & "aus einer Commandshell heraus mit wie folgt gestartet werden:" & vbcrlf & vbcrlf  & vbcrlf
warntext = warntext & "BerechtigungenReparieren.exe /scharf:YES /Userordner:H:\meineHomeverzeichnisse\Schueler" & vbcrlf & vbcrlf  & vbcrlf
warntext = warntext & "[wobei H:\meineHomeverzeichnisse\Schueler natürlich für den zu verändernden Ordner steht!!!]" & vbcrlf  
warntext = warntext & "[Tipp: wenn Ordner Leerzeichen haben, dann den Ordnername zwischen zwei "" sezten]" & vbcrlf 
warntext = warntext & "[Tipp2: das Tool funktioniert auch mit Freigaben, also zB \\meinServer\home$\schueler]" & vbcrlf & vbcrlf & vbcrlf
warntext = warntext & "Chefmodus: (Experts only)" & vbcrlf
warntext = warntext & "unten abgebildeten Quellcode mit dem Notepad als BerechtigungenReparieren.vbs speichern und folgendes ändern:" &vbcrlf
warntext = warntext & "in der Zeile mit dem Quelltext //   ' Modus = ""yes""  // muss lediglich das Hochkomma am Beginn gelöscht werden" & vbcrlf
warntext = warntext & "dann kann das Script auch per Doppelklick SCHARF gestartet werden!" & vbcrlf
warntext = warntext & "jetzt wird durch jeden DOPPELKLICK auf diese Datei BerechtigungenReparieren.vbs im jeweiligen Ordner und Unterordner die Berechtigungen geändert!" & vbcrlf & vbcrlf
warntext = warntext & "ACHTUNG: Es wird keine Haftung für etwaige Schäden übernommen!!! Also VORSICHT bei der Verwendung" & vbcrlf & vbcrlf
warntext = warntext & "[Feedback an Edi Pfisterer --> edi@schulnetz.info --> www.schulnetz.info]" & vbcrlf & vbCrLf  & vbcrlf & vbCrLf

Set objFSO = CreateObject("Scripting.FileSystemObject")

dateiname = "Berechtigungsänderungen.txt"

ueberordner = WScript.Arguments.Named.Item("Userordner")
         if len(ueberordner)= 0 then
                  scriptname = Wscript.ScriptFullName
                  ueberordner = objFSO.getparentfoldername(scriptname)
         end if
warntext = warntext & "Aktuelles Verzeichnis: " & ueberordner & vbcrlf & vbcrlf
Modus = WScript.Arguments.Named.Item("scharf")

' Modus = "yes"

 call InDateiSchreiben(warntext)

                        Set objShell = CreateObject("WScript.Shell")
					    objShell.Popup "Es werden nun alle eventuell zu verändernden Ordner einzeln aufpoppen! " & vbcrlf & "Lesen Sie in der Datei Benutzerberechtigungen.txt, die soeben angelegt wurde nach, wie Sie dieses Tool ""scharfstellen""!" & vbcrlf & "Um diese Tool zu stoppen, müssen Sie im Taskmanager die Datei wscript.exe beenden!", 20, "Info"
					    Set objShell = Nothing

call Ordnerliste(ueberordner)

function Ordnerliste(pfad)

        Set objFolder = objFSO.GetFolder(pfad)
        Set colSubfolders = objFolder.Subfolders

        For Each objSubfolder in colSubfolders
      ' msgbox objSubfolder
              on Error resume next

                 vollername = objFSO.GetAbsolutePathName(objSubfolder)

                NT_Benutzer = UserNameIsolieren(vollername)
                if Benutzerabfrage(NT_Benutzer) = 1 THEN
                   if instr(1,modus,"yes",1) = 0 Then  'es wird lediglich eine txt erzeugt, Dateien bleiben unverändert
                        call InDateiSchreiben(vollername)
                        call InDateiSchreiben("USER GIBTS")
                      befehl1 = "icacls " & vollername & " /setowner Administratoren /t /c /l /q "
                      befehl2 = "cacls " & vollername & " /T /G Administratoren:F " & NT_Benutzer & ":C"
                      befehl3 = "icacls " & vollername & " /setowner " & NT_Benutzer & " /t /c /l /q "
                     InDateiSchreiben befehl1
					 InDateiSchreiben befehl2 
					 InDateiSchreiben befehl3

                   Else 

                      befehl1 = "icacls " & vollername & " /setowner Administratoren /t /c /l /q "
                      befehl2 = "cacls " & vollername & " /T /G Administratoren:F " & NT_Benutzer & ":C"
                      befehl3 = "icacls " & vollername & " /setowner " & NT_Benutzer & " /t /c /l /q "

' InDateiSchreiben befehl1
' InDateiSchreiben befehl2 
' InDateiSchreiben befehl3

                      Set objShell = CreateObject("WScript.Shell")
                      objShell.Run "%comspec% /c echo j|" & befehl1, 0, 1
wscript.sleep 10
                      objShell.Run "%comspec% /c echo j|" & befehl2, 0, 1
wscript.sleep 10
                      objShell.Run "%comspec% /c echo j|" & befehl3, 0, 1
wscript.sleep 10

                      call InDateiSchreiben(vollername & " wurde auf den neuen Besitzer " & NT_Benutzer & " geändert!" & vbcrlf)

					   ' Set objShell = CreateObject("WScript.Shell")
					   ' objShell.Popup vollername & " wurde auf den neuen Besitzer " & NT_Benutzer & " geändert!", 5, "Info"
					   ' Set objShell = Nothing

						objFSO.DeleteFile(vollername & "\desktop.ini")

					end If

                end if

         call Ordnerliste(vollername)
        Next

end function

function InDateiSchreiben(inhalt)
  set logbuch1 =objFSO.opentextfile(dateiname, 8, true,0)  ' 8 zum anfügen
                logbuch1.write inhalt & vbcrlf
                logbuch1.close
end function

function UserNameIsolieren(strUsername)
  letzterBackslash = instrRev(strUsername,"\")
  laenge = len(strUsername)
  eigentlicherUsername = right(strUsername, laenge-letzterBackslash)
  'call InDateiSchreiben(eigentlicherUsername)
  UserNameIsolieren = eigentlicherUsername
end function

function benutzerabfrage(strUserName)

		 Set rootDSE = GetObject("LDAP://RootDSE")
		DomainName = rootDSE.Get("defaultnamingcontext")   

		strObjectName = strUserName
		strObjectType = "user"  
		strRootSearch = DomainName    

		Set objConnection = CreateObject("ADODB.Connection")  
		objConnection.Open "Provider=ADsDSOObject;"    
		Set objCommand = CreateObject("ADODB.Command")  
		objCommand.ActiveConnection = objConnection    

		objCommand.CommandText = _      
		"<LDAP://" & strRootSearch & ">;(&(objectCategory=" & strObjectType & ")" & _      
		"(samAccountName=" & strObjectName & "));samAccountName,distinguishedName;subtree"    

		Set objRecordSet = objCommand.Execute    

		If objRecordset.RecordCount = 0 Then      

		benutzerabfrage = 0
		else
		benutzerabfrage = 1
		end if 

objConnection.Close 

end function

msgBox "Ich bin fertig!"

Home Directorys auf anderen Fileserver übersiedeln – Änderungen im AD per Script

Script zur Automatisierung des Eintrags von Homedrives bei Active Directory Usern

(z. B. im Falle einer Fileserver-Migration, einer Änderung des Laufwerksbuchstabens, Umstieg auf DFS  o. ä.)
  1. Share auf neuen Ordner einrichten
  2. Kopie der Daten mit
    (das Folgende ist als Vorschlag zu betrachten – bitte selbst die Flags prüfen…)
    xcopy quelle ziel /Y /O /H /F /I /C /S
  3. oder
    Ordner mit Total-Commander auf den neuen Server kopieren (ACHTUNG: muss mit einem Benutzer [Domänen-Admin?] gemacht werden, der auch Leserechte auf den Ordnern besitzt
    (Kontrolle: Sicherheitseinstellungen auf den Homeshares der Benutzer…) 

    WICHTIG WICHTIG WICHTIG:
    Das Hakerl muss bei „NTFS-Berechtigungen kopieren“ gesetzt sein!!!!!
  4. Folgendes Script „HomeDirecotryChanger.vbs“ über die Einträge im Active Directory laufen lassen, damit die User beim nächsten Login auch die richtigen Ordner gemappt bekommen…
    [ Script ist ein Sammelsurium aus Eigenem und Fremdem  – die „Ablage“ hier dient lediglich dazu, dass ich es nicht selbst immer suchen muss, wenn ichs wieder brauche…]
    btw: man könnte das auch mit der Powershell erledigen…
  5. Es gibt im Ordner ein schönes Logfile, mit dessen Hilfe man überprüfen kann, ob es bei manchen Usern Troubles gab (weil er zB bisher gar kein Homedrive eingetragen hatte oder ähnliches!)
'###########################################################################
'# Usage:
'#  als    homedirectorychanger.vbs      an beliebiger Stelle auf einem Client speichern
'#
'# Variablen, die geändert werden MÜSSEN
'# ACHTUNG: strOU ist in 'verkehrter' Reihenfolge, dh:
'# strOU = "OU=1A,OU=Schueler,OU=benutzer," steht für alle User,
'# die in der OU=TEST sind, die wiederum in der OU= Benutzer liegt
'# Hier findest Du zusätzliche Infos zu LDAP-Attributen:
'# http://www.computerperformance.co.uk/Logon/LDAP_attributes_active_directory.htm

strOU = "OU=benutzer,"   'ACHTUNG auf den Beistrich!!
OldServer = "hp-y"
MyNewServer = "idefix"
HomeDriveKey = "H:"

'# Ab hier nur mehr für Auskenner veränderbar...
'############################################################################
on error resume next
Dim rootDSE, domainObject
Set rootDSE = GetObject("LDAP://RootDSE")
domainContainer = rootDSE.Get("defaultNamingContext")
Set domainObject = GetObject("LDAP://" & strOU & domainContainer)

Set fs = CreateObject ("Scripting.FileSystemObject")
Set outFile = fs.CreateTextFile (".\logfile_ADKonten.txt")

exportUsers(domainObject)

Set oDomain = Nothing

Sub ExportUsers(oObject)
on error resume next
   Dim oUser
   For Each oUser in oObject
      Select Case oUser.Class
         Case "user"

			call changeHomeDirectory(oUser.distinguishedName, oUser.homeDirectory)

         Case "organizationalUnit" , "container"

			ExportUsers(oUser)
      End select
   Next
End Sub

sub changeHomeDirectory(myUser, myHomeDirectory)

On Error Resume Next
Err.Clear

	Set objUser = GetObject("LDAP://"& myUser)
	myNEWHomeDirectory = replace(myHomeDirectory, OldServer, MyNewServer, 1, -1, 1)
	wscript.sleep 10
	objUser.Put "homeDirectory", myNEWHomeDirectory
	wscript.sleep 10
	objUser.Put "homeDrive", HomeDriveKey
	wscript.sleep 10
	objUser.SetInfo
	wscript.sleep 20

	outfile.WriteLine  "Set objUser = GetObject(""LDAP://"& myUser &"," & strOU & domainContainer & CHR(34) & ")"
	outfile.WriteLine  "objUser.Put ""homeDirectory"", " & CHR(34) & myNEWHomeDirectory & CHR(34)
	outfile.WriteLine  "objUser.Put ""homeDrive"", " & CHR(34) & HomeDriveKey & CHR(34)
	if  Err.Number <> 0  then
       outfile.WriteLine   "Fehler: Error number: " & Err.Number & "    Error description: " & Err.Description
	end if

	outfile.WriteLine "_____"

end Sub
WScript.Quit
wscript.echo "Done"

User im AD inkl. Shares und Loginscript mittels .csv anlegen

Introduction
User_via_csv_anlegen.vbs ist ein Tool, mit dessen Hilfe man einfach und bequem eine beliebige Anzahl von Usern im Active Directory anlegen kann. Voraussetzung ist ein funktionierendes AD sowie eine csv-Datei, in der sowohl die Benutzernamen als auch die zugehörige Abteilung (bzw. Schulklasse) vermerkt sind.
 
[User_via_csv_anlegen.vbs is a Tool, that creates Users in an Active Directory Environment, which are first defined in a .csv. It also generates a complex 10-digits-long Password for each user and 2 Shares on a defined Server. A LoginScript will be written in the SYSVOL-Share, each User will be Member of an Organizational Unit and also a Security-Group, that is predefined in the .csv.
When work is done, the Administrator will find a password.csv in the directory, where he started User_via_csv_anlegen.vbs, which has all Users, Organizational Units and Passwords in it.
Have fun, using it…]
 

Das Skript hat folgende Features:

  • Die Benutzernamen werden aus einer .csv ausgelesen
  • Falls ein Benutzer im AD bereits vorhanden ist, wird man zur Änderung des Namens aufgefordert
  • Es wird am Domänencontroller bzw. im AD folgendes erstellt:
     
    • 2 Shares – eines als Homedrive, das zweite mit Leserechten für alle
    • für jede Abteilung / Schulklasse eine eigene OU (Organizational Unit)
    • eine Sicherheitsgruppe für jede Abteilung bzw. Schulklasse
    • ein 10stelliges, hochkomplexes Passwort wird generiert
    • ein Loginscript.bat im SYSVOL, welches die User zugewiesen bekommen
       
  • jeder Benutzer wird im Active Directory in der entsprechenden OU angelegt
  • Es werden die entsprechenden Sicherheitsberechtigungen auf den Ordnern erstellt
  • Zusätzlich zu den Admins erhält eine weitere Gruppe (Chefabteilung,  Lehrer) erhöhten Zugriff auf die Ordner
  • Es wird eine Datei mit allen Usernamen und Passwörtern generiert

Runs on:
Domänencontroller ab Windows Server 2003

Usage:

  • Das Skript in einen Ordner auf einem Domänencontroller speichern
  • im selben Ordner eine Datei namens meineUser.csv anlegen
  • die gewünschten User in die Datei meineUser.csv wie folgt schreiben:
Benutzername;Klasse
Max.Mustermann;1AK
Maxima.Musterfrau;1BK 

  • Anmerkung: während der Laufzeit erscheint keinerlei Meldung!
    Dies kann und wird – abhängig von der Useranzahl mehrere Minuten dauern!!!
    Ein Hinweis über die erfolgreiche Abarbeitung inkl. Anzahl der Benutzer erfolgt nach beendeter Arbeit!!!
     
  • rechtlicher Hinweis: Die Verwendung des Tools erfolgt auf eigene Gefahr, ich übernehme KEINE HAFTUNG für Schäden jedweder Art!!!
     

[Save the user_via_csv_anlegen.vbs whereever you want on one of your Domain Controllers. Put a meineUser.csv in the same Directory, which has all your Users in it. They must be written in the following way:
username;OrganizationalUnit
Run the Script by dobbleclicking, wait some Minutes (there will be NO messages during the work, except, a Username is allready existing. After the Script has run through, you will see a Message on your screen, telling you the number of created Users – and you will find a file named password.csv in the Directory, where you saved the script. ]
Keep in mind: You run this Script on your own risk! I do NOT assume any liability!

Download:

QuellCode:

'#################################################################################################################
'### Script, um User aus einer .csv per Skript im AD mit 10-stelligen, komplexem Passwort anlegen              ###
'### getestet auf Windows Server 2003 SP2, Server2003 R2 u 2008 R2 (jeweils Deutsch)                           ###
'### Ver 10/11/2012_01:03                                                                                        ###
'#################################################################################################################

'Set objComputer = CreateObject("Shell.LocalMachine")         ' nicht verändern!
Set objComputer = CreateObject("Wscript.Network")

'### folgende Variablen können (müssen abern nicht) verändert werden: ##

  ServerName = objComputer.Computername                          'Server, auf dem die Shares erstellt wurden; falls nicht anders
                                                                'angegeben, der DC auf dem das Script gestartet wird

  HomePfad = "C:\Homedrives"                                         'In diesem Pfad des Servers werden die Freigaben für das HomeVerzeichnis erstellt
  LesePfad = "C:\AllgemeinerLeseZugriff"                               'In diesem Pfad des Servers werden die Freigaben mit allgemeinen Leserechten erstellt

  HomeShare = "homeshare"                                   'Name der Freigabe, auf der die Homeverzeichnisse gespeichert werden.
  HomeDriveBuchstabe = "h:"
  LeseShare = "AllgemeinShare"                                        'Name der Freigabe mit Leserechten für alle!
  LeseDriveBuchstabe = "u:"

  Lehrer = "lehrer"                                             'Sicherheitsgruppe, in der die Lehrer Mitglieder sind -> diese erhalten erhöhte Rechte in den Shares

  DateiMitUserdaten = "meineUser.csv"                        'in dieser Datei sind die anzulegenden User erfasst;
                                                             'diese Datei muss nach folgendem Schema aufgebaut sein:
                                                             '[Anmerkung: als OU empfiehlt sich die in Schulen die Klassenbezeichnung oder der Jahrgang]

                                                             'username;OU

                                                             'Beispiel:
                                                             'Max.Mustermann;2012_13_1AK
                                                             'Maxima.Musterfrau;2012_13_2AK
                                                             '...

'### hier beginnt der Teil, der eher nur noch von Auskennern angefasst werden sollte ;-)  ##

Set objFS = CreateObject("scripting.filesystemobject")
Set WshShell = WScript.CreateObject("WScript.Shell")
Set rootDSE = GetObject("LDAP://RootDSE")
DomainName = rootDSE.Get("defaultnamingcontext")

' aus DC=hak-neusiedl,DC=local wird hak-neusiedl.local
DomainString = Replace(DomainName, "DC=", "")
DomainString = Replace(DomainString, ",", ".")

Informationen = "Benutzername;Klasse;Passwort" & vbCrLf
Randomize

Set myFile = objfs.OpenTextFile(DateiMitUserdaten, 1, true)
Do While not myfile.AtEndOfStream

zeile = (myfile.ReadLine)
tempArr = split(zeile,";")
MUsername = tempArr(0)
strOU = tempArr(1)
GroupString = tempArr(1)

'erstellt eine neue OU
If Not OUExists(strOU, "LDAP://" & DomainName) Then
    Set PrfOU = GetObject("LDAP://" & DomainName).Create("organizationalUnit", "ou=" & strOU)
    PrfOU.SetInfo
Else
    Set PrfOU = GetObject("LDAP://" & "ou=" & strOU& "," & DomainName)
End If

' erstellt, falls noch nicht vorhanden, eine neue Gruppe, in der die User Mitglied werden
If Not ObjectExists(GroupString, "group", "WinNT://" & DomainString) Then
    Set objGroup = PrfOU.Create("Group", "CN=" & GroupString)
    objGroup.Put "sAMAccountName", GroupString
    objGroup.SetInfo
End If
' Die Gruppe wird gesucht und als Ziel definiert.
Set GroupObj = GetObject("WinNT://" & DomainString & "/" & GroupString)

' Prüfung, ob Benutzer angelegt
Do While ObjectExists(MUsername, "user", "WinNT://" & DomainString) And Not Abbruch
    Do
        MUsername = InputBox(_
            "Die Bezeichnung " & tempArr(0) & " ist bereits vorhanden!" & vbCrLf & _
            "Bitte geben Sie eine andere Bezeichnung oder ""exit"" für Abbruch ein!")
    Loop Until MUsername <> ""
    If LCase(MUsername) = "exit" Then Abbruch = True
Loop

If NOT Abbruch Then

' erstellt den Pfad für die Freigaben
CreatePath HomePfad
CreatePath LesePfad & "\" & strOU

' es werden die Freigaben erzeugt
CreateShare HomeShare, HomePfad
CreateShare LeseShare, LesePfad

' Grundlegende Rechte für Angabe- und Pruefungsordner setzen
WshShell.Run "cmd /c echo j|cacls " & HomePfad & " /G Administratoren:F " & Lehrer & ":C " & GroupString & ":R", 0, 1
WshShell.Run "cmd /c echo j|cacls " & HomePfad & " /E /G " & GroupString & ":W", 0, 1
WshShell.Run "cmd /c echo j|cacls " & LesePfad & " /G Administratoren:F " & Lehrer & ":C " & GroupString & ":R", 0, 1
WshShell.Run "cmd /c echo j|cacls " & LesePfad & "\" & StrOU & " /G Administratoren:F " & Lehrer & ":C ", 0, 1

' loginscript schreiben
LoginScriptName = StrOU & ".bat"
LoginScriptPfad = "sysvol\" & DomainString & "\Scripts\Abschluss\Login"
LoginScript = "\\" & DomainString & "\" & LoginScriptPfad & "\" & LoginScriptName
LoginScriptPfadLokal = "C:\WINDOWS\SYSVOL" & "\" & LoginScriptPfad
LoginScriptDatei = LoginScriptPfadLokal & "\" & LoginScriptName
CreatePath LoginScriptPfadLokal

Set objTextStream = objFS.CreateTextfile(LoginScriptDatei)
objTextStream.write "net use " & LeseDriveBuchstabe & " \\" & ServerName & "\" & LeseShare & "\" & strOU
objTextStream.Close

    ' die Verzeichnisse für die SchülerInnen werden erstellt;

    CreatePath "\\" & ServerName & "\" & HomeShare & "\" & StrlOU & "\" & MUsername

    ' die User werden nun im AD angelegt

    'Passwort = "Passwort" & i & "-" & Int(10000 * rnd + 1)
    Passwort = Kennwort(10)

    Set usr = PrfOU.Create("user", "CN=" & MUsername)
    usr.Put "samAccountName", MUsername
    usr.Put "userPrincipalName", MUsername & "@" & DomainString
    usr.Put "homeDirectory", "\\" & ServerName & "\" & HomeShare & "\" & StrOU & "\" & MUsername
    usr.Put "homeDrive", HomeDriveBuchstabe
    usr.Put "scriptPath", LoginScript
    usr.SetInfo
    usr.SetPassword Passwort
    usr.AccountDisabled = False
    usr.SetInfo
    WScript.Sleep (1000)

    Informationen = Informationen & vbCrLf & MUsername & ";" & strOU & ";" & Passwort
    i = i + 1

    GroupObj.Add ("WinNT://"& DomainString & "/" & MUsername)
    WScript.Sleep (1000)

    ' die Berechtigungen werden in den Verzeichnissen der User gesetzt
    PermL1 = "Administratoren:F " & Lehrer & ":C " & MUsername & ":R "
    PermL2 = MUsername & ":W "
    PermA = "Administratoren:F " & Lehrer & ":C " & MUsername & ":R "

WshShell.Run "cmd /c echo j|cacls \\" & ServerName & "\" & HomeShare & "\" & strOU & "\" & MUsername & " /G " & PermL1 , 0, 1
WshShell.Run "cmd /c echo j|cacls \\" & ServerName & "\" & HomeShare & "\" & strOU & "\" & MUsername & " /E /G " & PermL2 , 0, 1
WshShell.Run "cmd /c echo j|cacls \\" & ServerName & "\" & LeseShare & "\" & strOU & " /E /G " & PermA , 0, 1

    WScript.Sleep (1000)
    end if
Loop

' die csv mit den Usern und Passwörtern wird erstellt
strDateiname = "Usernames_und_passwoerter.csv"
Set objTextStream = objFS.CreateTextFile(strDateiname, True)
objTextStream.write Informationen
objTextStream.Close

If i > 0 Then
    Erfolg = "Fertig: " & i & " Benutzer angelegt"
Else
    Erfolg = "Keine User angelegt."
End If

WScript.Echo Erfolg

Function Zeichen(Anfang, Ende)
    Zufall = Int((Ende - Anfang + 1) * Rnd + Anfang)
    Zeichen = Chr(Zufall)
End Function

Function Verschiebe(VWort)
    WLaenge = Len(VWort)
    NeuWort = ""
    ReDim WFeld(WLaenge)
    For t = 1 To WLaenge
        WFeld(t) = Mid(VWort, t, 1)
    Next
    Zahl = 0
    Do Until Len(NeuWort) = WLaenge
        j = Int((WLaenge) * Rnd + 1)
        If WFeld(j) <> "" Then
            NeuWort = NeuWort & WFeld(j)
            WFeld(j) = ""
        End If
        Zahl = Zahl + 1
        If Zahl > 1000 Then Exit Do ' Zur Sicherheit
    Loop
    Verschiebe = NeuWort
End Function

Function Kennwort(KennwortLaenge)
If KennwortLaenge > 128 Then KennwortLaenge = 128
Wort = ""
Wort = Zeichen(48, 57) ' Ziffern
Wort = Wort & Zeichen(65, 90) ' Großbuchstaben
Wort = Wort & Zeichen(97, 122) ' Kleinbuchstaben
Wort = Wort & Zeichen(33, 47) ' Satzzeichen
If KennwortLaenge > 4 Then
    For t = 5 To KennwortLaenge
        Wort = Wort & Zeichen(33, 122)  'sonstige Zeichen
    Next
End If
Wort = Verschiebe(Wort) ' Zeichenfolge zufällig ändern
Kennwort = Wort
Kennwort = Replace(Kennwort, " ", "_")
Kennwort = Replace(Kennwort, ";", "_")
Kennwort = Replace(Kennwort, """", "_")
End Function

Sub CreatePath(FullPath) 'Rekursive Erstellung eines Pfades
If Not objFS.FolderExists(FullPath) Then
    Folder = objfs.GetFileName(FullPath)
    ParentPath = objfs.GetParentFolderName(FullPath)
    If Right(ParentPath, 1) <> "\" Then ParentPath = ParentPath & "\"
    CreatePath(ParentPath)
    objFS.CreateFolder(ParentPath & Folder)
End If
End Sub

Sub CreateShare(ShareName, SharePath)
Set Freigaben = GetObject("WinNT://" & ServerName & "/LanmanServer,FileService")
Angelegt = False
For Each Freigabe In Freigaben
    If LCase(Freigabe.Name) = LCase(ShareName) Then
        Angelegt = True
        Exit For
    End If
Next
If Not Angelegt Then
    Set fs = Freigaben.Create("FileShare", ShareName)
    fs.Path = SharePath
    fs.MaxUserCount = -1
    fs.SetInfo
End If
Set Freigaben = Nothing
Set fs = Nothing
End Sub

Function OUExists(OUName, ParentOU)
Set Container = GetObject(ParentOU)
Container.Filter = Array("organizationalUnit")
OUExists = False
For Each OU In Container
    If LCase(OU.ou) = LCase(OUName) Then
        OUExists = True
        Exit For
    End If
Next
End Function

Function ObjectExists(ObjectName, ObjectType, DomainRoot)
Set Dom = GetObject(DomainRoot)
Dom.Filter = Array(ObjectType)
ObjectExists = False
For Each Obj In Dom
    If LCase(Obj.Name) = LCase(ObjectName) Then
        ObjectExists = True
        Exit For
    End If
Next
End Function

Tip:
Ich würde das Script vorerst mit 2 – 10 Usern aus unterschiedlichen Schulklassen testen, und eventuell Änderungen im Script nach erfolgtem Test vornehmen…
Das Skript wurde möglichst übersichtlich gehalten, sodass es auch für VBScript-Newbies möglich sein sollte, die entsprechenden Zeilen aufzustöbern, in denen nötige Änderungen vorzunehmen sind.
Falls jemand die Sicherheitseinstellungen der Ordner verändern möchte, dann sind alle Zeilen, in denen cacls vorkommt, diejenigen, die verändert werden müssen!

Credits:
Danke an Nils Kaczenski für ein paar Code-Schnipsel und bastla aus www.administrator.de, der am Ursprungsscript, auf dem dieses hier basiert, tatkräftig mitgeholfen hat!

OuShutdown 1.2 ist fertig!

Introduction
OuShutdown sammelt alle Clients einer oder mehrerer Organisationseinheiten eines Active Directory und fährt sie herunter (remote shutdown).
Sofern ein Windows DHCP-Server verwendet wird, können die Clients mittels eines Magic Pakets auch aus dem Standby „geweckt“ werden, bevor sie herunterfahren.
Das Tool kann entweder direkt in einer CommandShell oder als geplanter Task verwendet werden.

[OuShutdown is a Tool, that collects all members of 1 ore more Organizational Unit(s) within an Active Directory and starts a remote shutdown for all clients in that OU]

Runs on:
Client Windows XP oder höher
Server 2003 oder höher

Installation
Kopiere OuShutdown in Dein bevorzugtes Verzeichnis. Ein Doppelklick auf die Datei zeigt die Syntax an, die in einer Commandshell zu verwenden ist.
[Copy OuShutdown onto your executable path. Typing „OuShutdown“ displays its usage syntax. ]

Download:
OuShutdown.exe [[downloadcounter(oushutdown.exe)] x heruntergeladen]

Die Nutzung des Tools ist gratis – Vertrieb nur nach vorheriger Genehmigung durch mich!
[Usage is for free – All rights reserved by Edi Pfisterer]

Usage:
OuShutdown.exe /ou:Dv1,Dv2,Dv3 [/dhcp:servername]

DV1,DV2,DV3 steht für die OUs, in der alle Clients heruntergefahren werden sollten
optional: SERVERNAME steht für den Windows-DHCP-Server (zum Wecken aus dem Standby)

Tipp:
Wenn das Tool als „geplanter Task“ eingesetzt wird, dann müssen die Flags außerhalb der Anführungszeichen manuell eingetragen werden…

PS:
Zusatzfeature: In dem Ordner, in dem das Tool gespeichert wird, wird eine alleInfos.csv angelegt, die alle Clients  inkl. OU, IP-Adresse und MAC-Adresse beinhält…

Credits:
Dank an
Matthias Zirngibl [http://masterbootrecord.de/docs/wakeup.php] für die Verwendung seiner wake.exe

Additional Backgroundinformations:
– es muss eine funktionierende Windows Active Directory – Domäne vorhanden sein
– aus Sicherheitsgründen muss das Tool mit einer DomänenAdministratorenKennung ausgeführt werden.
– Das Tool funktioniert auch in Netzen, die in VLANs aufgeteilt sind.
– Clients, die in der OU „Computers“ sind, können nicht angesteuert werden!
– Bei Windows7-Clients muss bei der Netzwerkkarte „Allow this device to wake the Computer“ angehakt sein, damit der Client auch heruntergefahren werden kann, wenn er im Standby schlummert.

Sicherungs/Löschscripts

Nachdem ich bei mehreren Kunden nächtliche Komplettsicherungen mache, hier ein ein batch-Script zum erstellen der Sicherungen und ein VBScript, das dazu dient, diese Sicherungen nach n Tagen wieder automatisiert zu löschen.
Ich glaube mich zu erinnern, dass ich Teile des (oder das gesamte?) Script aus dem Netz habe…
Sollte der mögliche Urheber sein Werk hier (teilweise) wiedererkennen, dann möge er mir bitte Bescheid geben…

(Ich stelle das Script hier trotz mangelnder Urheberschaft ab, damit ich es unterwegs stets parat habe, und anstatt zu tippen copypasten kann… [was bei vielen meiner Artikel ein wichtiger Antrieb ist])

1.) sicherungerstellen.bat

md f:\!!!backup\%date%

xcopy C:\officeVHD\*.vhd f:\!!!BACKUP\%date%\*.* /Y /J /R

 

2.) sicherungloeschen.vbs

AlterinTagen = -8

Basisordner = "S:\Termin-Sicherung"

Heute = FormatDateTime(Date, 2)
OldDate = DateAdd("d", AlterinTagen, now()) 

Set objFS = CreateObject("Scripting.FilesystemObject")

If objFS.FolderExists(Basisordner) Then
    DoFolder objFS.GetFolder(Basisordner)

End If

'für "Erstellungsdatum" anstelle von "DateLastModified" "DateCreated" verwenden
Sub DoFolder(Folder)
For Each File In Folder.Files
    If File.DateLastModified < OldDate Then File.Delete
Next

For Each SubFolder In Folder.SubFolders
        If SubFolder.DateLastModified < OldDate Then
        WScript.Echo SubFolder.Delete
    Else
        DoFolder SubFolder
        If (SubFolder.SubFolders.Count + SubFolder.Files.Count) = 0 Then SubFolder.Delete 'leere Unterordner löschen
    End If
Next
End Sub