'''' change profile paths 

SMTPServer = "mail.ukstokes.ad"
Set domain = GetObject("LDAP://OU=Company Users,DC=ukstokes,DC=ad")  
NewTSPath = "\\ukstokes.ad\data\profiles$\users\"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set outputfile = objFso.CreateTextFile("C:\output1.csv", True)
outputfile.Write "User,New_Profile_Path" & vbCRLF

intCounter = 0 

SetTSPath domain  
SendEmail
'msgbox intCounter & " Accounts were modified." & vbCRLF & "See C:\output1.csv for details.", vbinformation, "Finished"
  
Sub SetTSPath (parent)  
  
	For each child in parent  
 		If child.class = "organizationalUnit" Then

			set objOU = GetObject("LDAP://" & child.distinguishedName )
			For each objUser in objOU
				If objUser.class="user" Then

					If objUser.ProfilePath = "" Then
						'Do nothing if the user doesn't have a profile path
						outputfile.Write objuser.sAMAccountName & ",No existing user profile" & vbCRLF
					else
						objUser.ProfilePath = NewTSPath & objuser.sAMAccountName 
						objUser.SetInfo
						outputfile.Write objuser.sAMAccountName & "," & objUser.ProfilePath & vbCRLF						
						intCounter = intCounter +1
					End If

				End If
			Next	

		SetTSPath (child)  
		End If

	Next  
	
End Sub  

Private Function SendEmail
	Set objEmail = CreateObject("CDO.Message")
	objEmail.From = "ben@------.ad"
	objEmail.To = "ben@------.ad"
	objEmail.Subject = "Profile Path updates" 
	objEmail.Textbody = intCounter & " Accounts were modified. See attached log file for details."
	outputfile.close
	objEmail.AddAttachment("C:\output1.csv")
	objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
	objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPServer
	objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
	objEmail.Configuration.Fields.Update
	objEmail.Send
End Function