Option Explicit

Const ADS_PROPERTY_CLEAR = 1
Const ADS_PROPERTY_APPEND = 3

Dim strExcelPath, objExcel, objSheet, intRow, strUserDN, strhomeDirectory, strDomain, strDNSdomain
Dim strLine, logFSO, objLogFile, strProfile
Dim objUser, objFSO, objFolder, strDocs, strObject, strUserName, objRootLDAP, strAdminGroup
Dim a, commandline, sreturn, ireturn, output, commandlinepro


Set a=createobject("fileacl.fileacl")

'               SET DOMAIN

'               strDomain = "domain-ua"
                strDomain = "domain-local"

'               SET DNS DOMAIN

'               strDNSdomain = "domain.ua"
                strDNSdomain = "domain.local"

                strAdminGroup = "GLS-Admins-Data"



' Check for required arguments.
If (Wscript.Arguments.Count < 1) Then
    Wscript.Echo "Argument <SpreadsheetName> required. For example:" _
        & vbCrLf _
        & "cscript uu.vbs C:\Users\admin-user\Desktop\PROFILES\users.xls"
    Wscript.Quit(0)
End If

createLog
strExcelPath = Wscript.Arguments(0)

On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If (Err.Number <> 0) Then
    On Error GoTo 0
    Wscript.Echo "Excel application not found."
                WritetoLog "Excel application not found."
    Wscript.Quit
End If

On Error GoTo 0

On Error Resume Next
objExcel.Workbooks.Open strExcelPath
If (Err.Number <> 0) Then
    On Error GoTo 0
    Wscript.Echo "Spreadsheet cannot be opened: " & strExcelPath
                WritetoLog "Spreadsheet cannot be opened: " & strExcelPath
    Wscript.Quit
End If
On Error GoTo 0

Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

intRow = 2
Do While objSheet.Cells(intRow, 1).Value <> ""
    strUserName = Trim(objSheet.Cells(intRow, 1).Value)
    Wscript.Echo "Processing user "& strUserName
    Writetolog "Processing user "& strUserName

    strUserDN = GetObjectDN(strUserName, strDomain)
    strhomeDirectory = cStr(ProfilePath(strUserName))
    strProfile = cStr(ProPath(strUserName))

    If (strhomeDirectory <> "") Then
        On Error Resume Next
        Set objUser = GetObject("LDAP://" & strUserDN)
                Set objFSO = CreateObject("Scripting.FileSystemObject")
        If (Err.Number <> 0) Then
            On Error GoTo 0
            Wscript.Echo "User NOT found " & strUserDN
                    WritetoLog "User NOT found " & strUserDN
        Else
            On Error GoTo 0
            If (LCase(strhomeDirectory) = ".delete") Then
                On Error Resume Next
                objUser.PutEx ADS_PROPERTY_CLEAR, "homeDirectory", 0
                objUser.SetInfo
                If (Err.Number <> 0) Then
                    On Error GoTo 0
                    Wscript.Echo "Unable to clear profilePath for user " _
                        & strUserDN
                                    WritetoLog "Unable to clear profilePath for user " _
                        & strUserDN
                End If
                On Error GoTo 0
            Else
                                objUser.Put "profilePath", strhomeDirectory & strUserName & "\Roaming"
                                objUser.SetInfo
                                If objFSO.FolderExists(strhomeDirectory & strUserName) Then
                                                Set objFolder = objFSO.GetFolder(strhomeDirectory & strUserName)
                                                Wscript.Echo "Profile Directory for user " & strUserName & " already exists"
                                                WritetoLog "Profile Directory for user " & strUserName & " already exists"
                                Else
                                                Set objFolder = objFSO.createFolder(strhomeDirectory & strUserName)
                                                Wscript.Echo "Profile Directory for user " & strUserName & " created"
                                                WritetoLog "Profile Directory for user " & strUserName & " created"
                                End If
                                commandline=strhomeDirectory & strUserName
                                commandlinepro=strProfile & strUserName
                                ireturn=a.Execute(commandline& " /S "& strUserName& ":F", output)
                                WritetoLog "Profile Directory User permissions results = " & ireturn
                                ireturn=a.Execute(commandline& " /S "& strAdminGroup& ":F", output)
                                WritetoLog "Profile Directory Admin permissions results = " & ireturn
                                If objFSO.FolderExists(strhomeDirectory & strUserName & "\Roaming.v2") Then
                                                Set objFolder = objFSO.GetFolder(strhomeDirectory & strUserName)
                                                Wscript.Echo "Roaming.v2 Directory for user " & strUserName & " already exists"
                                                WritetoLog "Roaming.v2 Directory for user " & strUserName & " already exists"
                                Else
                                                Set objFolder = objFSO.createFolder(strhomeDirectory & strUserName & "\Roaming.v2")
                                                Wscript.Echo "Roaming.v2 Directory for user " & strUserName & " created"
                                                WritetoLog "Roaming.v2 Directory for user " & strUserName & " created"
                                End If
                                ireturn=a.Execute(commandline& "\Roaming.v2"& " /S "& strUserName& ":F", output)
                                WritetoLog "Roaming.v2 Directory User permissions results = " & ireturn
                                ireturn=a.Execute(commandline& "\Roaming.v2"& " /S "& strAdminGroup& ":F", output)
                                WritetoLog "Roaming.v2 Directory Admin permissions results = " & ireturn
                                ireturn=a.Execute(commandline& "\Roaming.v2"& " /O "& strUserName, output)
                                WritetoLog "Roaming.v2 Directory User Ownership results = " & ireturn
                                If objFSO.FolderExists(strhomeDirectory & strUserName & "\Roaming") Then
                                                Set objFolder = objFSO.GetFolder(strhomeDirectory & strUserName)
                                                Wscript.Echo "Roaming Directory for user " & strUserName & " already exists"
                                                WritetoLog "Roaming Directory for user " & strUserName & " already exists"
                                Else
                                                Set objFolder = objFSO.createFolder(strhomeDirectory & strUserName & "\Roaming")
                                                Wscript.Echo "Roaming Directory for user " & strUserName & " created"
                                                WritetoLog "Roaming Directory for user " & strUserName & " created"
                                End If
                                ireturn=a.Execute(commandline& "\Roaming"& " /S "& strUserName& ":F", output)
                                WritetoLog "Roaming Directory User permissions results = " & ireturn
                                ireturn=a.Execute(commandline& "\Roaming"& " /S "& strAdminGroup& ":F", output)
                                WritetoLog "Roaming Directory Admin permissions results = " & ireturn
                                ireturn=a.Execute(commandline& "\Roaming"& " /O "& strUserName, output)
                                WritetoLog "Roaming Directory User Ownership results = " & ireturn
                                If objFSO.FolderExists(strProfile & strUserName & "\Roaming") Then
                                                Set objFolder = objFSO.GetFolder(strProfile & strUserName)
                                                Wscript.Echo "Previous XP Roaming Directory for user " & strUserName & " found"
                                                WritetoLog "Previous XP Roaming Directory for user " & strUserName & " found"
                                                ireturn=a.Execute(commandlinepro& "\Roaming"& " /INHERIT /REPLACE /SUB:5 /FORCE", output)
                                                WritetoLog "Previous XP Roaming Directory permissions results = " & ireturn
                                End If
                                If objFSO.FolderExists(strProfile & strUserName & "\Roaming.v2") Then
                                                Set objFolder = objFSO.GetFolder(strProfile & strUserName)
                                                Wscript.Echo "Previous Vista Roaming Directory for user " & strUserName & " found"
                                                WritetoLog "Previous Vista Roaming Directory for user " & strUserName & " found"
                                                ireturn=a.Execute(commandlinepro& "\Roaming.v2"& " /INHERIT /REPLACE /SUB:5 /FORCE", output)
                                                WritetoLog "Previous Vista Roaming Directory permissions results = " & ireturn
                                End If
                                On Error Resume Next
                                Wscript.sleep 1000

                If (Err.Number <> 0) Then
                    On Error GoTo 0
                    Wscript.Echo "Unable to process profilePath for user " _
                        & strUserDN
                    WritetoLog "Unable to process profilePath for user " _
                        & strUserDN
                End If
                On Error GoTo 0
            End If
        End If
    End If

    intRow = intRow + 1
Loop

objExcel.ActiveWorkbook.Close

Wscript.Echo "Done"
WritetoLog "Done"
closeLog



Function GetObjectDN(strObject, strDomain) 
        ' Return Type: String 
        ' 
        ' Returns a Distinguished Name for an Object from it's NT SAM ID. 
        ' This will only function for valid object types within an NT Domain structure. 
  
        Const ADS_NAME_INITTYPE_GC = 3 
        Const ADS_NAME_TYPE_1779 = 1 
        Const ADS_NAME_TYPE_NT4 = 3 
  
        Dim objNameTranslate 
        Dim strObjectDN 
  
        On Error Resume Next : Err.Clear 
        Set objNameTranslate = CreateObject("NameTranslate") 
  
        objNameTranslate.Init ADS_NAME_INITTYPE_GC, "" 
        objNameTranslate.Set ADS_NAME_TYPE_NT4, strDomain & "\" & strObject 
        strObjectDN = objNameTranslate.Get(ADS_NAME_TYPE_1779) 
        If Err.Number <> 0 Then  ' Make the DN Blank for a Failed Search 
                strObjectDN = "" 
        End If 
  
        Set objNameTranslate = Nothing 
        On Error Goto 0 
  
        GetObjectDN = strObjectDN 
End Function

Function ProfilePath(strUserName)
                Dim objRegExp

                set objRegExp = New RegExp
                objRegExp.IgnoreCase = True
                objRegExp.Pattern = "[a-j]"

                If objRegExp.Test(Left(strUserName, 1)) Then
                                                ProfilePath = "\\" & strDNSDomain & "\Profiles-users1$\profiles\"
                Else
                                                ProfilePath = "\\" & strDNSDomain & "\Profiles-users2$\profiles\"
                End If
End Function

Function ProPath(strUserName)
                Dim objRegExp

                set objRegExp = New RegExp
                objRegExp.IgnoreCase = True
                objRegExp.Pattern = "[a-j]"

                If objRegExp.Test(Left(strUserName, 1)) Then
                                                ProPath = "\\" & strDNSDomain & "\Users- users1$\users\"
                Else
                                                ProPath = "\\" & strDNSDomain & "\Users- users2$\users\"
                End If
End Function

Sub createLog
                On Error Resume Next
                set logFSO = CreateObject("scripting.FileSystemObject")
                set objLogFile = logFSO.CreateTextFile("Profiles_" & Day(Now) & Month(Now) & Year(Now) & ".log")
                if Err.Number <> 0 Then
                                WScript.Echo "Unable to create log file!"
                                WScript.Quit
                End If
                
End Sub                

Sub closeLog
                objLogFile.Close
End Sub

Sub writetoLog (strLine)
                Dim strlogLine
                strlogLine = Now & ": " & strLine
                objLogFile.WriteLine(strlogLine)
                WScript.Echo strlogLine
End Sub