Change Windows password without knowing local user password. VBS Script.

changing windows password.vbs

Option Explicit

RunAsAdmin()

Dim objDomain, User, List, strAccount
Dim strNewPass, status
On Error Resume next

'Find current Users on computer, and select one.
'------------------------------------------------
Set objDomain = GetObject("WinNT://.")
objDomain.Filter = Array("user")
List = Array()
For Each User In objDomain
ReDim Preserve List(UBound(List) + 1)
List(UBound(List)) = User.Name
Next

status = "(Select a username.)"

Do
strAccount = InputBox(status&vbLf&"•"&Join(List, vbLf&"•"),"Password Changer", "Enter a username.")
If IsEmpty(strAccount) Then
 MsgBox "Canceled",vbCritical
 WScript.Quit
ElseIf IsInArray(strAccount, List) Then
 Exit Do
Else
 status = "(User doesn't exist.)"
End If
Loop

'Change password for selected user>>>>.
'------------------------------------------------
 status = "(User selected, please enter a new password)"
 strNewPass = InputBox(status&vbLf&"•"&strAccount,"Password Changer", "Enter a new password.")
 If IsEmpty(strNewPass) Then
 MsgBox "Canceled",vbCritical
 WScript.Quit
 Else

 GetObject("WinNT://./" &strAccount& ", user").SetPassword strNewPass
 
  If Err.Number = 0 And Not Err.Number = -2147024810 Then 
  MsgBox "Password for "&strAccount&","&vbLf& "has been changed to """&strNewPass&"""",vbInformation
  WScript.Quit
  Else
  MsgBox Err.Description &vbLf& Err.Number
  End If
 End If

'Functions.
'------------------------------------------------

Function IsInArray(strIn, arrCheck)
Dim bFlag : bFlag = False
 If IsArray(arrCheck) AND Not IsNull(strIn) Then
 Dim i
 For i = 0 to UBound(arrCheck)
  If arrcheck(i) = strIn Then
  bFlag = True
 Exit For
  End If
 Next
 End If
 IsInArray = bFlag
End Function

Function RunAsAdmin()
 Dim objSHL, objAPL
 Set objSHL = WScript.CreateObject("Wscript.Shell")
  If WScript.Arguments.length = 0 Then
  Set objAPL = CreateObject("Shell.Application")
  objAPL.ShellExecute "wscript.exe", """" & _
  WScript.ScriptFullName & """" & _
  " RunAsAdministrator", , "runas", 1
  WScript.Quit
  End If
End Function