' *** Процедура переименовывает ПК пользователя ********************************************************
Sub Rename_PC (HostName)
On Error Resume Next
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H0001
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")
strPathtoTextFile = "C:\Sbersign\" 'Путь к каталогу с файлом, содержащим имена ПК, подлежащие переименованию
objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & strPathtoTextFile & ";" & "Extended Properties=""text;HDR=YES;FMT=Delimited"""
objRecordset.Open "SELECT * FROM PC.csv", objConnection, adOpenStatic, adLockOptimistic, adCmdText 'Имя файла, содержащего имена ПК, подлежащие переименованию
Do Until objRecordset.EOF
    if HostName=objRecordset.Fields.Item("Old_Name_PC") then
        Name_PC = objRecordset.Fields.Item("New_Name_PC")
        Password = "пароль_пользователя"
        Username = "домен\пользователь"
        Set objWMIService = GetObject("Winmgmts:root\cimv2")
      ' Call always gets only one Win32_ComputerSystem object.
        For Each objComputer in objWMIService.InstancesOf("Win32_ComputerSystem")
            Return = objComputer.rename(Name_PC,Password,Username)
            If Return <> 0 Then
              Call WriteTOLogFile ( Now() & " ПК не переименован. Код ошибки = " & Err.Number)
              Exit Sub
            Else
              Call WriteTOLogFile ( Now() & " ПК успешно переименован. Необходима перезагрузка ПК.")
              Exit Sub
            End If
        Next
    end if
    objRecordset.MoveNext
Loop
Set objConnection = Nothing
Set objRecordSet = Nothing
End Sub

Dim Name, Password, Username

Name = "iWS-011"

Password = "password"

Username = "domain\Administrator"

Set objWMIService = GetObject("Winmgmts:root\cimv2")

' Call always gets only one Win32_ComputerSystem object.

For Each objComputer in _

   objWMIService.InstancesOf("Win32_ComputerSystem")

       Return = objComputer.rename(Name,Password,Username)

       If Return <> 0 Then

'wscript.echo "Rename failed. Error Code = " & Err.Number

    Else

          'WScript.Echo "Rename succeeded." & _

              '" Reboot for new name to go into effect"

'wscript.echo "Successfully Changed Hostname"    

End If

Next

cd /d c:\kuku
psexec.exe /accepteula -u домен\vasia.pupkin -p Vasia_password "%windir%\system32\wscript.exe" "renamePC.vbs" 

Dim WshNetwork : Set WshNetwork = WScript.CreateObject("WScript.Network")
Dim strOldComputerName : strOldComputerName = WshNetwork.ComputerName
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim strLog : strLog = "c:\log_renamePC.txt"
strComputerName = InputBox("Enter a new machine name for this computer:", "Rename Computer : " & strOldComputerName)

strUsername = "adm_pk"
strPassword = "xxxxxxx"
strNamespace = "root\cimv2"

'on error resume next
Set objWbemLocator = CreateObject("WbemScripting.SWbemLocator")
Set objWMIService = objwbemLocator.ConnectServer(strComputerName, strNamespace, strUser, strPassword)
objWMIService.Security_.authenticationLevel = WbemAuthenticationLevelPktPrivacy

if Err.Number <> 0 then
 WScript.Echo "Authentication failed: " & Err.Description
end if

Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & "." & "\root\cimv2")
Set colComputers = objWMIService.ExecQuery ("Select Name from Win32_ComputerSystem")
For Each objComputer in colComputers
    On Error Resume Next
    Err.Clear
    intErrorCode = objComputer.Rename(strComputerName)
    If intErrorCode <> 0 OR Err.Number<>0 Then
        Dim sErr : sErr = Err.Description
        Set objOutputFile = fso.OpenTextFile(strLog, 8, true)
        objOutputFile.WriteLine( now() & vbTab & strOldComputerName & vbTab & strComputerName & vbTab & "Error: "  &_
            CStr(intErrorCode) & " -- " & sErr) 
        objOutputFile.Close
        Set objOutputFile = Nothing
        MsgBox "Error renaming computer. Error # " & intErrorCode & vbCrLf & sErr
    Else
        Set objOutputFile = fso.OpenTextFile(strLog, 8, true)
        objOutputFile.WriteLine( now() & vbTab & strOldComputerName & vbTab & strComputerName & vbTab & "OK" )
        objOutputFile.Close
        Set objOutputFile = Nothing
        MsgBox "Computer renamed. It will now reboot."
        objShell.Run "shutdown.exe -r -f -t 0"
    End If
Next

Dim WshNetwork : Set WshNetwork = WScript.CreateObject("WScript.Network")
Dim strOldComputerName : strOldComputerName = WshNetwork.ComputerName
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim strLog : strLog = "c:\log_renamePC.txt"

strComputerName = InputBox("Enter a new machine name for this computer:", "Rename Computer : " & strOldComputerName)
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & "." & "\root\cimv2")
Set colComputers = objWMIService.ExecQuery ("Select Name from Win32_ComputerSystem")
For Each objComputer in colComputers
    On Error Resume Next
    Err.Clear
    intErrorCode = objComputer.Rename(strComputerName)
    If intErrorCode <> 0 OR Err.Number<>0 Then
        Dim sErr : sErr = Err.Description
        Set objOutputFile = fso.OpenTextFile(strLog, 8, true)
        objOutputFile.WriteLine( now() & vbTab & strOldComputerName & vbTab & strComputerName & vbTab & "Error: "  &_
            CStr(intErrorCode) & " -- " & sErr) 
        objOutputFile.Close
        Set objOutputFile = Nothing
        MsgBox "Error renaming computer. Error # " & intErrorCode & vbCrLf & sErr
    Else
        Set objOutputFile = fso.OpenTextFile(strLog, 8, true)
        objOutputFile.WriteLine( now() & vbTab & strOldComputerName & vbTab & strComputerName & vbTab & "OK" )
        objOutputFile.Close
        Set objOutputFile = Nothing
        MsgBox "Computer renamed. It will now reboot."
        objShell.Run "shutdown.exe -r -f -t 0"
    End If
Next