OPTION EXPLICIT ' Variables must be declared
' *************************************************
' * Instructions
' *************************************************

' Edit the variables in the "Setup" section as required.
' Run this script from a command prompt in cscript mode.
' e.g. cscript usermod.vbs
' You can also choose to output the results to a text file:
' cscript usermod.csv >> results.txt

' *************************************************
' * Constants / Decleration
' *************************************************
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H0001
Const ADS_PROPERTY_CLEAR = 1

DIM strSearchAttribute 
DIM strCSVHeader, strCSVFile, strCSVFolder
DIM strAttribute, userPath
DIM userChanges
DIM cn,cmd,rs
DIM objUser
DIM oldVal, newVal
DIM objField
DIM blnSearchAttributeExists
' *************************************************
' * Setup
' *************************************************

' The Active Directory attribute that is to be used to match rows in the CSV file to
' Active Directory user accounts.  It is recommended to use unique attributes.
' e.g. sAMAccountName (Pre Windows 2000 Login) or userPrincipalName
' Other attributes can be used but are not guaranteed to be unique.  If multiple user 
' accounts are found, an error is returned and no update is performed.
strSearchAttribute = "sAMAccountName" 'User Name (Pre Windows 2000)

' Folder where CSV file is located 
strCSVFolder = "C:\"
' Name of the CSV File
strCSVFile = "usermod.csv"

' *************************************************
' * End Setup
' *************************************************

' Setup ADO Connection to CSV file
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
          "Data Source=" & strCSVFolder & ";" & _
          "Extended Properties=""text;HDR=YES;FMT=Delimited"""

rs.Open "SELECT * FROM [" & strCSVFile & "]", _
          cn, adOpenStatic, adLockOptimistic, adCmdText

' Check if search attribute exists
blnSearchAttributeExists=false
for each objField in rs.Fields
	if UCASE(objField.Name) = UCASE(strSearchAttribute) then
		blnSearchAttributeExists=true
	end if
Next
		
if blnSearchAttributeExists=false then
	MsgBox "'" & strSearchAttribute & "' attribute must be specified in the CSV header." & _
		VbCrLf & "The attribute is used to map the data the csv file to users in Active Directory.",vbCritical
	wscript.quit
end if

' Read CSV File
Do Until rs.EOF
	' Get the ADsPath of the user by searching for a user in Active Directory on the search attribute
	' specified, where the value is equal to the value in the csv file.
	' e.g. LDAP://cn=user1,cn=users,dc=wisesoft,dc=co,dc=uk
	userPath = getUser(strSearchAttribute,rs(strSearchAttribute))
	' Check that an ADsPath was returned
	if LEFT(userPath,6) = "Error:" then
		wscript.echo userPath
	else
		wscript.echo userPath
		' Get the user object
		set objUser = getobject(userpath)
		userChanges = 0
		' Update each attribute in the CSV string
		for each objField in rs.Fields
			strAttribute = objField.Name
			oldval = ""
			newval = ""
			' Ignore the search attribute (this is used only to search for the user account)
			if UCASE(strAttribute) <> UCASE(strSearchAttribute) and UCASE(strAttribute) <> "NULL" then
				newVal = rs(strAttribute) ' Get new attribute value from CSV file
				if ISNULL(newval) then
					newval = ""
				end If
				' Special handling for common-name attribute. If the new value contains
				' commas they must be escaped with a forward slash.
				If strAttribute = "cn" then
					newVal = REPLACE(newVal,",","\,")
				end If
				' Read the current value before changing it
				readAttribute strAttribute
								
				' Check if the new value is different from the update value
				if oldval <> newval then
					wscript.echo "Change " & strAttribute & " from '" & oldVal & "' to '" & newVal & "'"
					' Update attribute
					writeAttribute strAttribute,newVal
					' Used later to check if any changes need to be committed to AD
					userChanges = userChanges + 1
				end If
			end If
		next
		' Check if we need to commit any updates to AD
		if userChanges > 0 then
			' Allow script to continue if an update fails
			on error resume next
			err.clear
			' Save Changes to AD
			objUser.setinfo
			' Check if update succeeded/failed
			if err.number <> 0 then
				wscript.echo "Commit Changes: Failed. " & err.description
				err.clear
			else
				wscript.echo "Commit Changes: Succeeded"
			end if
			on error goto 0
		else
			wscript.echo "No Changes"
		end if
		
	end If

 	userPath = ""
    rs.MoveNext
Loop

' Cleanup
rs.close
cn.close
' *************************************************
' * End of script
' *************************************************

' *************************************************
' * Functions
' *************************************************
' Reads specified attribute and sets the value for the oldVal variable
Sub readAttribute(ByVal strAttribute)
	Select Case LCASE(strAttribute) 
		Case "manager_samaccountname" 
			' special handling to allow update of manager attribute using sAMAccountName (UserName)
			' instead of using the distinguished name
			Dim objManager, managerDN
			' Ignore error if manager is null
			On Error Resume Next
			managerDN = objUser.Get("manager")
			On Error GoTo 0
			If managerDN = "" Then
				oldVal=""
			Else
				Set objManager = GetObject("LDAP://" & managerDN)
				oldVal = objManager.sAMAccountName
				Set objManager=Nothing
			End If
		Case "terminalservicesprofilepath"
			'Special handling for "TerminalServicesProfilePath" attribute
			oldVal=objUser.TerminalServicesProfilePath
		Case "terminalserviceshomedirectory"
			'Special handling for "TerminalServicesHomeDirectory" attribute
			oldVal = objUser.TerminalServicesHomeDirectory
		Case "terminalserviceshomedrive"
			'Special handling for "TerminalServicesHomeDrive" attribute
			oldVal=objUser.TerminalServicesHomeDrive
		Case "allowlogon"
			' Special handling for "allowlogon" (Terminal Services) attribute
			' e.g. 1=Allow, 0=Deny
			oldVal=objUser.AllowLogon
		Case "password"
			' Password can't be read, just return ****
			oldVal="****"
		Case Else
			on error resume next ' Ignore error if value is null
			' Get old attribute value
			oldVal = objUser.Get(strAttribute)
			On Error goto 0
	End Select
End Sub
' updates the specified attribute
Sub writeAttribute(ByVal strAttribute,newVal)
	Select Case LCASE(strAttribute)
		Case "cn" 'Special handling required for common-name attribute
			DIM objContainer
			set objContainer = GetObject(objUser.Parent)

			on error resume Next
			objContainer.MoveHere objUser.ADsPath,"cn=" & newVal

			' The update might fail if a user with the same common-name exists within
				' the same container (OU)
			if err.number <> 0 Then
				wscript.echo "Error changing common-name from '" & oldval & "' to '" & newval & _
						     "'.  Check that the common-name is unique within the container (OU)"
				err.clear
			End If
			on Error goto 0
		Case "terminalservicesprofilepath"
			'Special handling for "TerminalServicesProfilePath" attribute
			objUser.TerminalServicesProfilePath=newVal
		Case "terminalserviceshomedirectory"
			'Special handling for "TerminalServicesHomeDirectory" attribute
			objUser.TerminalServicesHomeDirectory=newVal
		Case "terminalserviceshomedrive"
			'Special handling for "TerminalServicesHomeDrive" attribute
			objUser.TerminalServicesHomeDrive=newVal
		Case "allowlogon" 
			' Special handling for "allowlogon" (Terminal Services) attribute
			' e.g. 1=Allow, 0=Deny
			objUser.AllowLogon=newVal
		Case "password"
			' Special handling for setting password
			objUser.SetPassword newVal
		Case "manager_samaccountname" 
			' special handling to allow update of manager attribute using sAMAccountName (UserName)
			' instead of using the distinguished name
			If newVal = "" Then
				objUser.PutEx ADS_PROPERTY_CLEAR, strAttribute, Null
			Else
				Dim objManager, managerPath, managerDN
				managerPath = GetUser("sAMAccountName",newVal)
				If LEFT(managerPath,6) = "Error:" THEN
					wscript.echo "Error resolving manager DN:" & managerPath
				Else
					SET objManager = GetObject(managerPath)
					managerDN = objManager.Get("distinguishedName")
					Set objManager = Nothing
					objUser.Put "manager",managerDN
				End If
			End If	
		Case ELSE ' Any other attribute
			' code to update "normal" attribute
			If newVal = "" then
				' Special handling to clear an attribute
				objUser.PutEx ADS_PROPERTY_CLEAR, strAttribute, Null
			Else
				objUser.put strAttribute,newVal
			End If
	End Select
End Sub

' Function to return the ADsPath of a user account by searching
' for a particular attribute value
' e.g. LDAP://cn=user1,cn=users,dc=wisesoft,dc=co,dc=uk
Function getUser(Byval strSearchAttribute,strSearchValue)
	DIM objRoot
	DIM getUserCn,getUserCmd,getUserRS

	on error resume next
	set objRoot = getobject("LDAP://RootDSE")

	set getUserCn = createobject("ADODB.Connection")
	set getUserCmd = createobject("ADODB.Command")
	set getUserRS = createobject("ADODB.Recordset")

	getUserCn.open "Provider=ADsDSOObject;"
	
	getUserCmd.activeconnection=getUserCn
	getUserCmd.commandtext="<LDAP://" & objRoot.get("defaultNamingContext") & ">;" & _
			"(&(objectCategory=person)(objectClass=user)(" & strSearchAttribute & "=" & strSearchValue & "));" & _
			"adsPath;subtree"
	
	set getUserRs = getUserCmd.execute

	if getUserRS.recordcount = 0 then
		getUser = "Error: User account not found"
	elseif getUserRS.recordcount = 1 then
     	getUser = getUserRs(0)
	else
		getUser = "Error: Multiple user accounts found.  Expected one user account."
	end if
	
	getUserCn.close
end function