Laufwerksmapping aller Freigegebenen Ordner einer OU mit vbScript

' Region Description
'
' Name:			userloginscript.vbs
' Author:		Mirko Härtwig
' Version:		v0.1
' Description:	Userloginscript, 
'				- ermittelt die OU des angemeldeten Users, 
'				- mountet die In der OU eingetragenen Verzeichnisfreigaben
' 				- bereits gemountete Laufwerke werden dismountet
'               - mappt die in der OU eingetragenen Drucker (enthält die Beschreibung den String "Default" 
'                 wird der Drucker als Standarddrucker verwendet, der bisherige Standarddrucker wird dadurch überschrieben) 
' ToDo:         - Verknüpfungen kopieren
'               - Scriptinventory beim ersten Start in der Woche ausführen
'               - prüfen ob lokaler Drucker existiert, dann keinen Netzwerkdrucker als Standart setzen ?????? 
'                 * Option: Prüfen ob Drucker in einer Liste/Array existiert
' 
' EndRegion

Option Explicit

Dim objNetwork
Dim objADSysInfo
Dim objUser					' User
Dim objOU					' OrgUnit
Dim objV					' Volume
Dim objKey					' Keywords (Array)
Dim objPq					' PrintQueue
Dim objPdescr				' Printer Description

Dim defprt					' Default Printer (True/False)

  Set objNetwork = WScript.CreateObject( "WScript.Network" )
  Set objADSysInfo = CreateObject("ADSystemInfo")
  Set objUser = GetObject("LDAP://" & objADSysInfo.UserName)
  Set objOU = GetObject(objUser.parent)

  ' === Ausgabe diverser Angaben =============================================
  WScript.Echo "Username: ............... " + objNetwork.userName
  WScript.Echo "Domänenname: ............ " + objNetwork.userDomain
  WScript.Echo "Organisationseinheit: ... " + objOU.Name
  WScript.Echo "Computername: ........... " + objNetwork.ComputerName
  WScript.Echo "Clientname: ............. " 
  WScript.Echo "Sitename: ............... " + objADSysInfo.SiteName
  WScript.Echo "Anmeldeserver: .......... " 

  ' === Alle Verzeichnisfreigaben der OU mounten
  objOU.Filter = Array("volume")
  For Each objV In objOU
	For Each objKey In objV.keywords
		MapNetworkShare objKey, objV.uNCName
	Next
  Next

  objOU.Filter = Array("printqueue")
  For Each objPq In objOU
	defprt = False
	If InStr(UCase(objPq.description), UCase("Default")) <> 0 Then defprt = True
	
	MapPrinter objPq.printerpath, defprt
  Next


'Region Subroutines

Sub MapNetworkShare(LocalDrive, NetworkPath)
'
' Author:		Mirko Härtwig
' Description:	Mappt eine Netzwerkfreigabe auf ein spezielles Laufwerk. Ggf. vorhandene Mappings
'				auf dieses Laufwerk werden vorher entfernt

Dim objNetwork

	Set objNetwork = WScript.CreateObject("WScript.Network")
	On Error Resume Next

	objNetwork.RemoveNetworkDrive LocalDrive, True, True
	If Err.Number <> 0 Then WScript.Echo "Can not remove Networkdrive """ & LocalDrive & """ " & _
	Chr(13) & Chr(10) & "Reason: " & Err.Description
	
	objNetwork.MapNetworkDrive LocalDrive, NetworkPath
	If Err.Number <> 0 Then 
		WScript.Echo "Can not map path """ & NetworkPath & """ to drive """ & LocalDrive & """." & _
		Chr(13) & Chr(10) & "Reason: " & Err.Description
	Else
	    WScript.Echo "Connect network share """ & NetworkPath & """ to drive """ & LocalDrive & """."
	End If
	

End Sub

Sub MapPrinter(PrinterPath, DefaultPrinter)
'	
' Author:		Mirko Härtwig
' Description:	Mappt einen Drucker. Ggf vorhandene Mappings werden vorher nicht entfernt
'

Dim objNetwork

	Set objNetwork = WScript.CreateObject("WScript.Network")
	On Error Resume Next
	
	objNetwork.AddWindowsPrinterConnection PrinterPath
	If Err.Number <> 0 Then 
		WScript.Echo "Can not add Printer Connection """ & PrinterPath & """ " & _
		Chr(13) & Chr(10) & "Reason: " & Err.Description
	Else
		WScript.Echo "Add Printer Connection """ & PrinterPath & """."
	End If
	
	If DefaultPrinter Then 
		objNetwork.SetDefaultPrinter PrinterPath

		If Err.Number <> 0 Then 
			WScript.Echo "Can not set """ & PrinterPath & """ as default Printer." & _
			Chr(13) & Chr(10) & "Reason: " & Err.Description
		Else
			WScript.Echo "Set Printer Connection """ & PrinterPath & """ as default Printer."
		End If
	End If


End Sub

'EndRegion