The password is statically set in the script; please be careful when running this as it does try to attach to EVERY computer in the domain

-------------------------------------------------------------------------------------------------------------------------------

' --------------------------------------------------------
'           ScriptingAnswers.com ScriptVault
' --------------------------------------------------------
'
' Brief desscription:
'  Goes through your AD domain and changes the local
'  administrator password on each computer. Be careful!
'
'
'
' --------------------------------------------------------
' Version history:
' 1.0   02/17/2006  Initial release
'
' --------------------------------------------------------
' The user of this script accepts all responsibility For
' reviewing, testing, and using it, and specifically
' holds harmless ScriptingAnswers.com, SAPIEN Technologies,
' and the script's original author from any damages which
' result from the use of this script, including any
' direct, consequential, or indirect damages which may
' result.
' --------------------------------------------------------

' --------------------------------------------------------
' DOCUMENTED DEPENDENCIES
' Things this script relies on or assumes are already
' in place, apart from things which are built into
' WinXP or later:
'  Relies on Windows XP or Win2003.
' --------------------------------------------------------

 

' --------------------------------------------------------
' VARIABLE DECLARATIONS
' --------------------------------------------------------
Option Explicit
Dim rootDSE, domainObject

' --------------------------------------------------------
' STATIC VARIABLE ASSIGNMENTS
' --------------------------------------------------------

 

' --------------------------------------------------------
' MAIN SCRIPT CODE
' --------------------------------------------------------
 'connect to the root of AD
Set rootDSE=GetObject("LDAP://RootDSE")
domainContainer = rootDSE.Get("defaultNamingContext")
Set oDomain = GetObject("LDAP://" & domainContainer)

'start with the domain root
WorkWithObject(oDomain)

MsgBox "Done!"

' --------------------------------------------------------
' SUBS AND FUNCTIONS
' --------------------------------------------------------
Sub WorkWithObject(oContainer)
 Dim oADObject
 For Each oADObject in oContainer
  Select Case oADObject.Class
   Case "user"

   Case "computer"
  ChangePassword(oADObject.cn)

   Case "organizationalUnit" , "container"
    WorkWithObject(oADObject)

  End Select
 Next
End Sub

Sub ChangePassword(strComputer)
 If TestPing(strComputer) Then
 
  On Error Resume Next
  Set objAdmin = GetObject("WinNT:\\" & strComputer & _
   "\Administrator,user")
  
  If Err = 0 Then
   objAdmin.SetPassword "P@ssw0rd!"
   objAdmin.SetInfo
  Else
   WScript.Echo strComputer & " skipped: " & _
    Err.Description
  End If
  On Error GoTo 0
  
 End If
End Sub

Function TestPing(sName)
 Dim cPingResults, oPingResult
 Verbose " Pinging " & sName
 Set cPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery("SELECT * FROM Win32_PinStatus WHERE Address = '" & sName & "'")
 For Each oPingResult In cPingResults
  If oPingResult.StatusCode = 0 Then
   TestPing = True
  Else
   TestPing = False
  End If
 Next
End Function