Tubebube

I added this function to make it work. Function CheckIfUserExists(userName) Dim arrComputers(1) 'Fixed Size Array arrComputers(0) = "" arrComputers(1) = "" For Each strComputer In arrComputers Set objComputer = GetObject("WinNT://" & strComputer & "") objComputer.Filter = Array("user") intFound = 0 For Each User In objComputer If lcase(User.Name) = lcase(userName) Then intFound = 1 End If Next Next If intFound = 1 Then CheckIfUserExists = True Else CheckIfUserExists = False End If End Function

Thanks so much for your help. I have figured out another approach to get this to work. Thanks again.

Thank you for responding. I have added a static string variable for the password. Below is my updated code. Also I get no errors. I get the WScript.Echo User.Name & " already exists and password reset." if the user name exists. If the user name does not exist the Sub Adduser routine adds the user name to systems correctly. This is a snapshot of the process. The password does not reset though. Again thank you for responding. ' ------- TEXT USED ---------- Title = "Change User Password" strGroup = "Users" staticPassword = "Tswt5387#0" Dim strComputer, objComputer, objUser ' ------ END TEXT USED -------- '------ GET INPUTS FROM USER ---------- Dim strUserName, strFullName, strPassword If Msgbox("Would you Like to Add a User?" , vbYesNo, Title) = vbYes then Call GetInputs Sub GetInputs Do strUserName = InputBox("Please Enter User Name.",Title) If strUserName = ""Then If MsgBox("Are you Sure you want to Quit?" , vbYesNo, Title)= VbNo Then End If End if Loop Until strUserName <> "" Do strFullName = InputBox("Please Enter Your Full Name.", Title) If strFullName = "" Then If MsgBox("Are you Sure you want to Quit?" , vbYesNo, Title)= VbNo Then 'Else Call Rename_Computer End If End If Loop Until strFullName <> "" Do strPassword = InputBox("Please Enter Password.",Title) If strPassword="" Then If MsgBox("Are you Sure you want to Quit?" , vbYesNo, Title)= VbNo Then End If End If Loop Until strPassword<>"" Call PreUser() Call AddUser() End Sub ' ------ END INPUTS --------------- ' ----- CODE TO PRECHECK FOR USER ACCT ---------- 'this section just changes the password if the user exists Sub PreUser Dim arrComputers(1) 'Fixed Size Array arrComputers(0) = "PC-1" arrComputers(1) = "PC-2" 'arrComputers = Array("SHI-PC") For Each strComputer In arrComputers Set objComputer = GetObject("WinNT://" & strComputer,"") 'Set objUser = objComputer.create("user", strUserName) objComputer.Filter = Array("user", strUserName) For Each User In objComputer If lcase(User.Name) = lcase(strUserName) Then 'strComputer = ("") On Error Resume Next Set objUser = GetObject("WinNT://" & strComputer & "/Users") Set objUser = objComputer.create("user", strUserName) If Err = 0 Then 'objUser.AccountDisabled = True objUser.SetPassword staticPassword objUser.Put "PasswordExpired", 1 objUser.SetInfo WScript.Echo User.Name & " already exists and password reset." WScript.Quit End If On Error GoTo 0 End If Next Next End Sub ' ----- END CODEODE TO PRECHECK FOR USER ACCT ---------- Sub AddUser 'Dim strUserName, objNetwork, objComputer 'arrComputers = Array("SHI-PC") Dim arrComputers(1) 'Fixed Size Array arrComputers(0) = "PC-1" arrComputers(1) = "PC-2" For Each strComputer In arrComputers Set objComputer = GetObject("WinNT://" & strComputer,"") Set objUser = objComputer.Create("user", strUserName) objUser.SetPassword strPassword objUser.FullName = strFullName objUser.Put "Description", strUserName objUser.Put "PasswordExpired", 1 objUser.SetInfo ' ----- CODE TO ADD USER TO GROUP ------- Set objGroup = GetObject("WinNT://" & strComputer & "/" & strGroup) objGroup.Add("WinNT://" & strComputer & "/" & strUserName) ' ----- END CODE TO ADD USER TO GROUP ----- Next Call MsgBox ("User Name: " & strUserName & vbCrLf & "Password: " &strPassword & VbCrLf & VbCrLf & "Please Write This Information Down.", 64, Title) 'Call AddGroup End Sub ' ----- END CODE TO ADD USER ------- '------ EXIT ----- Sub CleanUp Call MsgBox ("Click OK To Exit the Program",0, Title) WScript.quit End Sub End If '----- EXIT ------ ' Needs to be interactive: 'Check to see if user exist, if they exist then reset the password 'If they do not exist then create new user across multiple servers - CHECK 'Set user account to never expire - CHECK 'Set password to change when logon with an option not to change '***Extra- format the account name userid, fullname, description

Sub PreUser checks for existing user name on multiple systems in Array via input box from user. The problem is that it does not change the password. The other part's of this script work. Can anyone Help? ' ------- TEXT USED ---------- Title = "Change User Password" strGroup = "Users" ' ------ END TEXT USED -------- '------ GET INPUTS FROM USER ---------- Dim strUserName, strFullName, strPassword If Msgbox("Would you Like to Add a User?" , vbYesNo, Title) = vbYes then Call GetInputs Sub GetInputs Do strUserName = InputBox("Please Enter User Name.",Title) If strUserName = ""Then If MsgBox("Are you Sure you want to Quit?" , vbYesNo, Title)= VbNo Then End If End if Loop Until strUserName <> "" Do strFullName = InputBox("Please Enter Your Full Name.", Title) If strFullName = "" Then If MsgBox("Are you Sure you want to Quit?" , vbYesNo, Title)= VbNo Then 'Else Call Rename_Computer End If End If Loop Until strFullName <> "" Do strPassword = InputBox("Please Enter Password.",Title) If strPassword="" Then If MsgBox("Are you Sure you want to Quit?" , vbYesNo, Title)= VbNo Then End If End If Loop Until strPassword<>"" Call PreUser() Call AddUser() End Sub ' ------ END INPUTS --------------- ' ----- CODE TO PRECHECK FOR USER ACCT ---------- 'this section just changes the password if the user exists Sub PreUser Dim strComputer, objComputer, objUser 'Dim arrComputers2(1) 'Fixed Size Array 'arrComputers2(0) = "" 'arrComputers2(1) = "" arrComputers = Array("SHI-PC") For Each strComputer In arrComputers Set objComputer = GetObject("WinNT://" & strComputer,"")'GetObject("WinNT://" & strComputer2, "") 'Set objUser = objComputer.create("user", strUserName) objComputer.Filter = Array("user", strUserName) For Each User In objComputer If lcase(User.Name) = lcase(strUserName) Then strComputer = ("SHI-PC") On Error Resume Next Set objUser = GetObject("WinNT://" & strComputer & "/Users") Set objUser = objComputer.create("user", strUserName) If Err = 0 Then objUser.SetPassword "Password1" objUser.Put "PasswordExpired", 1 objUser.SetInfo WScript.Echo User.Name & " already exists and password reset." WScript.Quit End If On Error GoTo 0 End If Next Next End Sub ' ----- END CODEODE TO PRECHECK FOR USER ACCT ---------- Sub AddUser 'Dim strUserName, objNetwork, objComputer arrComputers = Array("SHI-PC") 'Dim arrComputers(1) 'Fixed Size Array 'arrComputers(0) = "" 'arrComputers(1) = "" For Each strComputer In arrComputers Set objComputer = GetObject("WinNT://" & strComputer,"") Set objUser = objComputer.Create("user", strUserName) objUser.SetPassword strPassword objUser.FullName = strFullName objUser.Put "Description", strUserName objUser.Put "PasswordExpired", 1 objUser.SetInfo ' ----- CODE TO ADD USER TO GROUP ------- 'Set objGroup = GetObject("WinNT://" & strComputer & "/" & strGroup) 'objGroup.Add("WinNT://" & strComputer & "/" & strUserName) ' ----- END CODE TO ADD USER TO GROUP ----- Next Call MsgBox ("User Name: " & strUserName & vbCrLf & "Password: " &strPassword & VbCrLf & VbCrLf & "Please Write This Information Down.", 64, Title) 'Call AddGroup End Sub ' ----- END CODE TO ADD USER ------- '------ EXIT ----- Sub CleanUp Call MsgBox ("Click OK To Exit the Program",0, Title) WScript.quit End Sub End If '----- EXIT ------ ' Needs to be interactive: 'Check to see if user exist, if they exist then reset the password 'If they do not exist then create new user across multiple servers - CHECK 'Set user account to never expire - CHECK 'Set password to change when logon with an option not to change '***Extra- format the account name userid, fullname, description