Logon script und windows vista

Dim strComputerName
Dim strUserName
Dim strDomainName
Dim BtnCode
Dim objADSysInfo
Dim wshNetwork
Dim WshShell
Dim WshSysEnv
Dim oShell
Dim oShFolder
Dim objUser
Dim objOU
Dim rootDSE
Dim oPq
Set wshNetwork = CreateObject("WScript.Network")  
Set WshShell = CreateObject("WScript.Shell")  
Set WshProcEnv = WshShell.Environment("Process")  
Set WshUserEnv = WshShell.Environment("USER")  
Set objADSysInfo = CreateObject("ADSystemInfo")  
Set oShell = CreateObject("Shell.application")  
Set oShFolder = oShell.Namespace(17)
Set objUser = GetObject("LDAP://" & objADSysInfo.UserName)  
Set objOU = GetObject(objUser.Parent)
Set objFSO = CreateObject("Scripting.FileSystemObject")  

'Warten bis der Anmeldename des Users ermittelt wurde  
Do While wshNetwork.UserName = ""  
WScript.Sleep 550
Loop


strComputerName = wshNetwork.computerName
strUserName = wshNetwork.UserName
strDomainName = wshNetwork.userDomain


Call subdrivemap
Call subdriverename
Call SubZusammenfassung


Sub subdrivemap()


On Error Resume Next
If (Err.Number <> 0) Then
    Call MsgBox("Error number   :" & Err.Number & CRLF & "Description    :" & Err.Description & CRLF & "Source         :" & Err.Source)  
End If

Err.Clear

'##### einen Moment Pause  
WScript.Sleep 1000

'#### ADSI abfragen  
adspath = "WinNT://" & strDomainName & "/" & strUserName  
Set adsobj = GetObject(adspath)

'##### vorhandene Laufwerke löschen  
wshNetwork.RemoveNetworkDrive "I:", True, True  
wshNetwork.RemoveNetworkDrive "L:", True, True  
wshNetwork.RemoveNetworkDrive "M:", True, True  
wshNetwork.RemoveNetworkDrive "P:", True, True  

'##### Laufwerke mappen  
wshNetwork.MapNetworkDrive "P:", "\\server\Daten"  
wshNetwork.MapNetworkDrive "I:", "\\server\Users\" & strUserName & ""  

For Each prop In adsobj.groups

Select Case UCase(prop.Name)
Case "DOMÄNEN-ADMINS"  
wshNetwork.MapNetworkDrive "M:", "\\server\NETLOGON"  
wshNetwork.MapNetworkDrive "L:", "\\server\DC-BKG-01.LOG"  


If (Err.Number <> 0) Then
    Call MsgBox("Error number: " & Err.Number & CRLF & "Description: " & Err.Description & CRLF & "Source:       " & Err.Source)  
End If
On Error GoTo 0

End Select
Next

End Sub

Sub subdriverename()
For Each oShFolderItem In oShFolder.Items
Select Case oShFolderItem.Path
Case "I:\" oShFolderItem.Name = "Meine persönlichen Daten"  
Case "L:\" oShFolderItem.Name = "Log Dateien"  
Case "M:\" oShFolderItem.Name = "Das Netlogon"  
Case "P:\" oShFolderItem.Name = "Daten"  

End Select
Next

Set oShell = Nothing
Set oShFolder = Nothing
Set oShFolderItem = Nothing
End Sub

Sub SubZusammenfassung()
Set colDrives = wshNetwork.EnumNetworkDrives
Set colPrinters = wshNetwork.EnumPrinterConnections
Dim CRLF
CRLF = Chr(13) & Chr(10)
Dim Company
Company = ""  

strMsg = "Anmelde Ergebnisse" & CRLF & CRLF & "Benutzername" & Chr(9) & "= " & strUserName & CRLF & "Computername" & Chr(9) & "= " & strComputerName & CRLF & "Domäne" & Chr(9) & Chr(9) & "= " & strDomainName & CRLF  
'* Verbundene Laufwerke Listen  
If colDrives.Count = 0 Then
strMsg = strMsg & CRLF & "Kein Netzlaufwerk ist verbunden." & CRLF  
Else
strMsg = strMsg & CRLF & "Verbundene Netzlaufwerk(e):" & CRLF  
For i = 0 To colDrives.Count - 1 Step 2
strMsg = strMsg & CRLF & colDrives(i) & Chr(9) & colDrives(i + 1)
Next

End If

'### Verbundene Drucker Listen  
If colPrinters.Count = 0 Then
strMsg = strMsg & CRLF & CRLF & _
"Kein Netzwerk-Drucker ist verbunden." & CRLF  

Else
    strMsg = strMsg & CRLF & CRLF & _
    "Verbundene Netzwerk-Drucker:" & CRLF  
    For i = 0 To colPrinters.Count - 1 Step 2
    strMsg = strMsg & CRLF & colPrinters(i) & _
    Chr(9) & colPrinters(i + 1)
Next
End If
strMsg = strMsg & CRLF & CRLF & "Dieses Fenster schließt sich in 10 Sekunden automatisch." & CRLF & "Eure Admins wünschen noch einen schönen Arbeitstag"  

BtnCode = WshShell.PopUp(strMsg, 10, Company, 64)

End Sub