Option Explicit
Dim oWin32_Services, oWin32_Service, ServerName, StartName, NewPassword, Messages

' ******************************************************
'Specify domain name, Windows account and new password in the following two lines:
StartName = "Domain\AccountName"  'Windows service account name, may also be in the form user@domain.com
NewPassword = "Type the NEW password here"

'Specify server list here. Modify ONLY the text between the quotes:

Call ChangeServerServicePasswords("ServerName1", StartName, NewPassword, Messages)
Call ChangeServerServicePasswords("ServerName2", StartName, NewPassword, Messages)
'Copy and paste the above line for each additional server, and change the server name accordingly

' ******************************************************

WScript.Echo Messages

Sub ChangeServerServicePasswords(ServerName, StartName, NewPassword, Messages)
Dim SQL
'Select all services running under this account
SQL = "SELECT * FROM Win32_Service WHERE StartName = '" & Replace(StartName, "\", "\\") & "'"
Set oWin32_Services = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & ServerName & "/root/cimv2").ExecQuery(SQL, , 48)

For Each oWin32_Service In oWin32_Services
  Call ChangeServicePassword(oWin32_Service, NewPassword, Messages)
Next

End Sub

Sub ChangeServicePassword(oWin32_Service, NewPassword, Messages)
Dim intResult

intResult = oWin32_Service.Change(,,,,,,,NewPassword)

If intResult = 0 Then
   Messages = Messages & oWin32_Service.SystemName & " " & oWin32_Service.Caption & " service account password changed for account " & oWin32_Service.StartName & vbcrlf
Else
   Messages = Messages & oWin32_Service.SystemName & " " & oWin32_Service.Caption & " service account password change failed for account " & oWin32_Service.StartName & ". Win32_Service.Change result is " & CStr(intResult) & vbcrlf
End If

End Sub