' UpdateUserProfile2.vbs
' VBScript program to update the profilePath attribute of user objects
' according to the information in a spreadsheet.
'
' ----------------------------------------------------------------------
' Copyright (c) 2004 Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
' Version 1.0 - January 13, 2004
' Version 1.1 - January 25, 2004 - Modify error trapping.
' Version 1.2 - March 18, 2004 - Modify NameTranslate constants.
' Version 1.3 - July 30, 2007 - Escape any "/" characters in User DN's.
' Version 1.4 - May 29, 2010 - Bug fix, only modify user when necessary.
'
' The input spreadsheet is a list of the NT logon name of each user
' whose profilePath attribute will be updated, one name per row. The
' user names are in the first column. The value to be assigned to the
' profilePath attribute is in the second column. The first row is
' skipped. The program processes each row until a blank entry is
' encountered in the first column. If the entry in the second column is
' the special value ".delete", the program will clear the profilePath
' attribute for that user. The program uses the NameTranslate object to
' convert the  NT name of the user (the sAMAccountName attribute) to the
' Distinguished Name required to bind to the user object with the LDAP
' provider.
'
' You have a royalty-free right to use, modify, reproduce, and
' distribute this script file in any way you find useful, provided that
' you agree that the copyright owner above has no warranty, obligations,
' or liability for such use.

Option Explicit

Const ADS_PROPERTY_CLEAR = 1
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1

Dim strExcelPath, objExcel, objSheet, intRow, strUserDN, strProfilePath
Dim objUser, strUserNTName, strOldPath
Dim objRootDSE, strDNSDomain, objTrans, strNetBIOSDomain

' Check for required arguments.
If (Wscript.Arguments.Count < 1) Then
    Wscript.Echo "Argument <SpreadsheetName> required. For example:"
    Wscript.Echo "cscript UpdateUserProfile2.vbs c:\Scripts\Users.xls"
    Wscript.Echo "Include the full path to the file."
    Wscript.Quit(0)
End If

' Spreadsheet file.
strExcelPath = Wscript.Arguments(0)

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

' Open spreadsheet.
On Error Resume Next
objExcel.Workbooks.Open strExcelPath
If (Err.Number <> 0) Then
    On Error GoTo 0
    Wscript.Echo "Spreadsheet cannot be opened: " & strExcelPath
    Wscript.Echo "Make sure you specify the full path to the file."
    Wscript.Quit
End If
On Error GoTo 0

' Bind to worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

' Determine DNS domain name from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")

' Use the NameTranslate object to find the NetBIOS domain name
' from the DNS domain name.
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_1779, strDNSDomain
strNetBIOSDomain = objTrans.Get(ADS_NAME_TYPE_NT4)
' Remove trailing backslash.
strNetBIOSDomain = Left(strNetBIOSDomain, _
    Len(strNetBIOSDomain) - 1)

' The first row of the spreadsheet is skipped (column headings). Each
' row after the first is processed until the first blank entry in the
' first column is encountered. The first column is the NT user name of
' the user, the second column is the new profilePath. The loop binds to
' each user object and assigns the new value for the attribute. intRow
' is the row number of the spreadsheet.
' Use the NameTranslate object to convert the NT user names
' to the Distinguished Name required for the LDAP provider.
intRow = 2
Do While objSheet.Cells(intRow, 1).Value <> ""
    strUserNTName = Trim(objSheet.Cells(intRow, 1).Value)
    ' Use NameTranslate to convert NT name to Distinguished Name.
    On Error Resume Next
    objTrans.Set ADS_NAME_TYPE_NT4, strNetBIOSDomain & "\" & strUserNTName
    If (Err.Number <> 0) Then
        On Error GoTo 0
        Wscript.Echo "User " & strUserNTName _
            & " not found in Active Directory"
    Else
        On Error GoTo 0
        strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
        ' Escape any forward slash characters, "/", with the backslash
        ' escape character. All other characters that should be escaped are.
        strUserDN = Replace(strUserDN, "/", "\/")

        strProfilePath = Trim(objSheet.Cells(intRow, 2).Value)
        If (strProfilePath <> "") Then
            On Error Resume Next
            Set objUser = GetObject("LDAP://" & strUserDN)
            If (Err.Number <> 0) Then
                On Error GoTo 0
                Wscript.Echo "User NOT found " & strUserDN
            Else
                On Error GoTo 0
                ' Retrieve existing value assigned to the attribute.
                ' If the value is Null, convert into an empty string.
                strOldPath = objUser.profilePath & ""
                If (LCase(strProfilePath) = ".delete") Then
                    ' Only remove the value if there is a value.
                    If (strOldPath <> "") Then
                        On Error Resume Next
                        objUser.PutEx ADS_PROPERTY_CLEAR, "profilePath", 0
                        objUser.SetInfo
                        If (Err.Number <> 0) Then
                            On Error GoTo 0
                            Wscript.Echo "Unable to clear profilePath for user " _
                                & strUserDN
                        End If
                        On Error GoTo 0
                    End If
                Else
                    ' Only modify the value if it differs from the existing.
                    If (strOldPath <> strProfilePath) Then
                        objUser.profilePath = strProfilePath
                        On Error Resume Next
                        objUser.SetInfo
                        If (Err.Number <> 0) Then
                            On Error GoTo 0
                            Wscript.Echo "Unable to set profilePath for user " _
                                & strUserDN
                        End If
                        On Error GoTo 0
                    End If
                End If
            End If
        End If
    End If
    intRow = intRow + 1
Loop

' Close the workbook.
objExcel.ActiveWorkbook.Close

' Quit Excel.
objExcel.Application.Quit

Wscript.Echo "Done"