On Error Resume Next
'LogEvent type constants
Const SUCCESS = 0
Const ERROR = 1
Const WARNING = 2
Const INFORMATION = 4
Const AUDIT_SUCCESS = 8
Const AUDIT_FAILURE = 16

strComputer="Server01"
strUser="roybiv"
strPassword=InputBox("What is the new password for " &_
 strComputer & "\" & strUser & "?","Change Password","P@ssw0rd")
 
Set objNetwork=CreateObject("WScript.Network")
Set objShell=CreateObject("WScript.shell")

Err.clear
set objUser=GetObject("WinNT://" & strComputer & "/" &_
 strUser & ",user")
if err.number<>0 Then
 strMsg= "Error connecting to " & strComputer & "." & VbCrLf
 strMsg=strMsg & "Error " & Hex(err.number) & " " & err.description
 objShell.LogEvent ERROR,strMsg
 WScript.quit
end If

objUser.SetPassword strPass
if err.number<>0 Then
 strMsg= "Error setting new password for " & strUser &_
  " on " & strComputer & "." & VbCrLf
 strMsg=strMsg & "Error " & Hex(err.number) & " " & err.description
 objShell.LogEvent WARNING,strMsg
Else
 strMsg="Successfully changed new  password for " & strUser &_
  " on " & strComputer & "." & VbCrLf
 strMsg=strMsg & "Changed by " & objNetwork.UserDomain &_
 "\" & objNetwork.UserName
 objShell.LogEvent SUCCESS,strMsg,strComputer
End If