' UpdateUserProfile.vbs
' VBScript program to update the profilePath attribute of user objects
' according to the information in a spreadsheet.
'
' ----------------------------------------------------------------------
' Copyright (c) 2003 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.
'
' 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 <SpreadsheetName> 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

' Clean up.
Set objUser = Nothing
Set objExcel = Nothing
Set objSheet = Nothing

Wscript.Echo "Done"