' 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"