' UpdateUserProfile.vbs ' VBScript program to update the profilePath attribute of user objects ' according to the information in a spreadsheet. ' ' ---------------------------------------------------------------------- ' Copyright (c) 2003-2010 Richard L. Mueller ' Hilltop Lab web site - http://www.rlmueller.net ' Version 1.0 - May 30, 2003 ' Version 1.2 - January 25, 2004 - Modify error trapping. ' Version 1.3 - November 6, 2010 - No need to set objects to Nothing. ' ' The input spreadsheet is a list of Distinguished Names of each user ' whose profilePath attribute will be updated, one name per row. The ' program CreateUserList3.vbs can be used to create the spreadsheet. ' Each user's Distinguished Name is 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. ' ' 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 Dim strExcelPath, objExcel, objSheet, intRow, strUserDN, strProfilePath Dim objUser ' Check for required arguments. If (Wscript.Arguments.Count < 1) Then Wscript.Echo "Argument required. For example:" _ & vbCrLf _ & "cscript UpdateUserProfile.vbs c:\MyFolder\UserList3.xls" 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.Quit End If On Error GoTo 0 ' Bind to worksheet. Set objSheet = objExcel.ActiveWorkbook.Worksheets(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 Distinguished ' 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. intRow = 2 Do While objSheet.Cells(intRow, 1).Value <> "" strUserDN = Trim(objSheet.Cells(intRow, 1).Value) 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 If (LCase(strProfilePath) = ".delete") 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 Else 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 intRow = intRow + 1 Loop ' Close the workbook. objExcel.ActiveWorkbook.Close ' Quit Excel. objExcel.Application.Quit Wscript.Echo "Done"