Do until loop problem
Hej EverybodyÆ' har et script som jeg skal have proppet et do until loop ind i, hvilket jeg har lidt problemer med.
Option Explicit
Dim strUsername, strDN, objOU, arrDN, strOU, strMsgBox, FSO, _
strBrugerdata, strTSProfiles, strTSHomedir
Const DELETE_READONLY = true
Const strTitle = "Delete User Account V. 1.0"
strUsername = Inputbox("Skriv hvilken bruger der skal slettes", strTitle)
do until Len(strUsername) <> 0 <----- jeg satte det ind her men det virker ikke...
If Len(strUsername) > 0 Then
strMsgBox = MsgBox("Er du sikker på du vil slette '"& strUsername &"', ALT data bliver slettet", 4, strTitle)
if strMsgBox = 6 then
'Bind user to LDAP provideren
strDN = GetUserDN(strUsername)
'Cut in the line so strOU shows the path to the OU the user is in
strOU = Mid(strDN, InStr(strDN, ",") + 1, Len(strDN) - InStr(strDN, ","))
'Split the user into arrays
arrDN = split(strDN, ",")
'Delete the user
On Error resume Next
Set objOU = GetObject("LDAP://" & strOU)
if Err.Number <> 0 Then
On Error Goto 0
MsgBox("Brugeren '" & strUsername & "' blev ikke fundet!")
Wscript.quit(1)
end if
On Error Goto 0
objOU.Delete "user", arrDN(0)
strBrugerdata = "\\mag4azkssc1fil2\brugerdata$\"
strTSProfiles = "\\mag4azkssc1fil2\tsprofiles$\"
strTSHomedir = "\\mag4azkssc1fil1\tshomedir$\"
'delete's shares
On error resume next
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
if FSO.FolderExists(strBrugerdata & strUsername) then
FSO.DeleteFolder (strBrugerdata & strUsername), DELETE_READONLY
if err.number <> 0 then
MsgBox ("Mappen " & strBrugerdata & strUsername & " kunne ikke slettes!" & vbCTRL & "Grund: " & err.Description)
Err.Clear
end if
end if
if FSO.FolderExists(strTSProfiles & strUsername) then
FSO.DeleteFolder (strTSProfiles & strUsername), DELETE_READONLY
if err.number <> 0 then
MsgBox ("Mappen " & strTSProfiles & strUsername & " kunne ikke slettes!" & vbCTRL & "Grund: " & err.Description)
Err.Clear
end if
End if
if FSO.FolderExists(strTSHomedir & strUsername) then
FSO.DeleteFolder (strTSHomedir & strUsername), DELETE_READONLY
if err.number <> 0 then
MsgBox ("Mappen " & strTSHomedir & strUsername & " kunne ikke slettes!" & vbCTRL & "Grund: " & err.Description)
Err.Clear
end if
end if
MsgBox(strUsername & " er nu slettet OG alle data!")
else
wscript.quit(1)
end if
End if
<----- loop
' ---
' Converts a NT username in the current NetBIOS domains to the corresponding distinguished name
Function GetUserDN(strUserNTName)
' Declare variables
Dim objRootDSE, strDNSDomain, objTrans, strNetBIOSDomain, strUserDN
' Create objects
Set objTrans = CreateObject("NameTranslate")
Set objRootDSE = GetObject("LDAP://RootDSE")
' Retrieve DNS domain name
strDNSDomain = objRootDSE.Get("defaultNamingContext")
' Convert DNS domain name to NetBIOS domain name
objTrans.Init 3, strDNSDomain
objTrans.Set 1, strDNSDomain
strNetBIOSDomain = objTrans.Get(3)
' Remove trailing backslash
If Right(strNetBIOSDomain, 1) = "\" Then strNetBIOSDomain = Left(strNetBIOSDomain, Len(strNetBIOSDomain) - 1)
' Enable internal errorhandling and clear errorlog
On Error Resume Next
Err.Clear
' Convert NT username to Distinguished Name
objTrans.Init 1, strNetBIOSDomain
objTrans.Set 3, strNetBIOSDomain & "\" & strUserNTName
' Check for error
If Err.Number <> 0 Then
GetUserDN = ""
End If
' Clear errorlog and disable internal errorhandling
Err.Clear
On Error GoTo 0
strUserDN = objTrans.Get(1)
' If the returned distinguished name doesn't contain a common name (CN), then the user doesn't exist
If InStr(strUserDN, "CN") > 0 Then
' Return distinguished name of the user
GetUserDN = strUserDN
Else
' Return empty string
GetUserDN = ""
End If
End Function
