From: Paul Glickenhaus on
I keep getting -2147463168 errors when I attempt to run this script. This
used to work but when I went back to actually continuing using it these
errors keep happening. I saw the microsofty post about this issue but it did
not correct my problem. The problem occurs during the GetObject Line.


Set oUser = GetObject("WinNT://" & Trim(sComputerName) & "/" &Trim(sOldUser)
& ",User")

Full code pasted below.

Any help would be greatly appreciated.

Paul


Dim oFSO
Dim memberlist
Dim cname
Dim changefile
Dim chngdadmin
Dim sComputerName
Dim strComputerName


Set oWshNet = CreateObject("WScript.Network")

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set memberlist = oFSO.OpenTextFile("C:\Program Files\DIT Security
Center\Administrator Account Change\memberservers.txt", 1, False)
Set changefile = oFSO.OpenTextFile("C:\Program Files\DIT Security
Center\Administrator Account Change\changefile.txt", 8, True)

'lnchfile.WriteLine "The DIT Security Center Utility to change the
Administrator Account and Passwords has been launched"
adminResponse = MsgBox("Are you sure that you want to change the
Administrator account on the Member Servers?" & vbCrLf & vbCrLf & "If YES,
you will be notified upon completion.", vbYesNo, "DIT Security Utility")
'If adminResponse = vbNo Then
'changefile.WriteLine "The task to change the administrtor accounts and
passwords has been cancelled."
'lnchfile.WriteLine "The task to change the administrtor accounts and
passwords has been cancelled."
'Call CancelMail
'End
'End If
WScript.Echo "Opened Change File"
changefile.WriteLine
"********************************************************"
changefile.WriteLine ""
changefile.WriteLine Date & vbTab & Time
changefile.WriteLine ""
Do Until memberlist.AtEndOfStream
cname = memberlist.ReadLine
WScript.Echo "Pinging: " & cname
Pinger (cname)
'MsgBox Pingcnt
If Pingcnt > 5 Then
changefile.WriteLine "Server Name: " & UCase(cname)
changefile.WriteLine UCase(cname) & " is not online"
changefile.WriteLine ""
Else
WScript.Echo cname & " is online"
sComputerName = cname

changefile.WriteLine "Server Name: " & sComputerName
' obtain current administrator name regardless of name
OldUser = GetAdministratorName(sComputerName)
WScript.Echo "Old Admin Account " & OldUser
changefile.WriteLine "Old Administrator Account: " & sOldUser
zz = 0
Do Until zz = 1000
zz = zz + 1
WScript.echo zz
Loop
' create new user name, 15 characters long
'It will contains characters from all of the following four categories:
'English upper case characters (A..Z)
'English lower case characters (a..z)
'Base 10 digits (0..9)
'Following non-alphanumeric characters: ()&$%#

'ChangeAdmin (sComputerName)

sNewUser = GenRandomName(15)
WScript.Echo "New UserName: " & sNewUser
sNewPwd = GenRandomName(15)
WScript.Echo "New Password: " & sNewPwd
'snewUser = InputBox("What is the new administrator Account")
'MsgBox sNewUser

Set oComputer = GetObject("WinNT://" & sComputerName)
If Err.Number <> 0 Then
MsgBox "Cannot Connect to Server"
End If
' Turn off internal error handling
On Error Resume Next
' connect to user object
Set oUser = GetObject("WinNT://" & Trim(sComputerName) & "/" &Trim(sOldUser)
& ",User")
If Err.Number <> 0 Then
WScript.Echo Err.Number & vbTab & Err.Description
Exit Do
End If
' rename user
zz = 0
Do Until zz = 1000
zz = zz + 1
WScript.Echo "Round 2 " & zz
Loop
'MsgBox oComputer
'oNewUser = ""
Set oNewUser = oComputer.MoveHere(oUser.AdsPath, sNewUser)
'MsgBox oNewUser & vbCrLf & oUser.AdsPath & vbCrLf & sNewUser

If Err.Number <> 0 Then
MsgBox Err.Number & vbTab & Err.Description


changefile.WriteLine "Failed to rename administrator user " & sOldUser
Err.Clear
changefile.WriteLine ""
Else
changefile.WriteLine "Administrator user is renamed to " & sNewUser
changefile.WriteLine ""

chngdadmin = GetAdministratorName(sComputerName)
WScript.Echo sComputerName
Wscript.Echo chngdadmin

'strComputer = "MyComputer"
Set objuser = GetObject("WinNT://" & sComputerName & "/" & chngdadmin & ",
user")
'MsgBox sNewPwd
Objuser.SetPassword sNewPwd
objuser.SetInfo
changefile.WriteLine "New Password: " & sNewPwd
changefile.WriteLine ""







End If
End If
'On Error GoTo 0
Loop
'If Err.Number <> 0 Then
' changefile.writeline Err.Number & vbTab & Err.Description
' Else
changefile.WriteLine ""
changefile.WriteLine "The admin account change has completed"
changefile.WriteLine Date & vbTab & Time
changefile.WriteLine "*****************************************************"

MsgBox "The Administrator Account update has completed", vbInformation, "DIT
Security Utility"
changefile.Close
'oFSO.Copyfile "C:\Program Files\DIT Security Center\Administrator Account
Change\changefile.csv", "\\file1\d$\wintel\Adminchange.csv"


'End If











Function GenRandomName(Ilen)
' Generates a random 15 character string to be used for both the renaming of
the administrator account and the new password

Randomize
'Do
sRS = ""
For iPos = 1 To Ilen
iChar = Int((69 * Rnd) + 1)
sRS = sRS & Mid("AEIUBCDFGHJKLMNPQRSTVWXYZ" _
& "aeioubcdfghjkmnpqrstvwxyz23456789()&!$#%", iChar, 1)
Next
'Loop Until REtest("[A-Z]", sRS) And REtest("[a-z]", sRS) _
'And REtest("\d", sRS) And REtest("[\(\)&\$%#]", sRS)

GenRandomName = sRS
End Function








Function GetAdministratorName(sComputerName)
' Connects to the remote member servers and determines the name of the local
administrator account based on the SID
Dim sUserSID, oWshNetwork, oUserAccount
WScript.Echo "Starting to get Administrator Account Name"
Set oUserAccounts = GetObject(
"winmgmts:{impersonationLevel=impersonate}!//" & sComputerName &
"/root/cimv2").ExecQuery( "Select Name, SID from Win32_UserAccount WHERE
Domain = '" & sComputerName & "'")

'On Error Resume Next
For Each oUserAccount In oUserAccounts
If Left(oUserAccount.SID, 9) = "S-1-5-21-" And _
Right(oUserAccount.SID, 4) = "-500" Then
GetAdministratorName = oUserAccount.Name
Exit For
End If
Next
WScript.Echo "Finished Getting Admin Account NAme"
End Function





Sub GetsAMAccountName(strCN)

Dim objRootDSE, strDNSDomain, objCommand, objConnection
Dim strBase, strFilter, strAttributes, strQuery, objRecordSet
Dim strDN, strDisplay, strObjectCategory, intIndex, myarray, objuser, strUPN
Dim renameResponse

' Determine DNS domain name.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")

' Use ADO to search Active Directory.
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
strBase = "<LDAP://" & strDNSDomain & ">"

strFilter = "(cn=" & strCN & ")"
strAttributes = "distinguishedName,objectCategory"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False
Set objRecordSet = objCommand.Execute

If objRecordSet.EOF Then
Wscript.Echo "Object not found with cn=" & strCN
Wscript.Quit
End If

'strDisplay = "Object(s) found"
Do Until objRecordSet.EOF
strDN = objRecordSet.Fields("distinguishedName")

strDisplay = strDisplay & vbCrLf & strDN & " (" _
& strObjectCategory & ")"
objRecordSet.MoveNext
Loop

myarray = Split(strDisplay, "(", -1)

Set objuser = GetObject _
("LDAP://" & myarray(0))


oldId = objuser.sAMAccountName

' Clean up.
objConnection.Close
Set objRootDSE = Nothing
Set objCommand = Nothing
Set objConnection = Nothing
Set objRecordSet = Nothing



End Sub



Sub Pinger(strcomputer)
Dim objPing
z = 0
Pingcnt = 0
Do Until z = 7
Set objPing =
GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select *
from Win32_PingStatus where address = '" & strcomputer & "'")


For Each objStatus In objPing

If IsNull(objStatus.StatusCode) Or objStatus.StatusCode <> 0 Then

Pingcnt = Pingcnt + 1
Else

End If
Next

z = z + 1
'WScript.Echo z
Loop
If Pingcnt > 5 Then
'rFile.WriteLine strcomputer & " is not Pingable"
rescnt = rescnt + 1
End If

End Sub
From: TDM on

"Paul Glickenhaus" <PaulGlickenhaus(a)discussions.microsoft.com> wrote in message
news:332A1365-E635-4FEB-92A4-6DCBB5942D4E(a)microsoft.com...
>I keep getting -2147463168 errors when I attempt to run this script. This
> used to work but when I went back to actually continuing using it these
> errors keep happening. I saw the microsofty post about this issue but it did
> not correct my problem. The problem occurs during the GetObject Line.
>
>
> Set oUser = GetObject("WinNT://" & Trim(sComputerName) & "/" &Trim(sOldUser)
> & ",User")
>
> Full code pasted below.
>

I do believe that translates to &H80005000, maybe this will help ?

http://www.computerperformance.co.uk/Logon/code/code_80005000.htm


TDM