Option Explicit
Const OldName = "usertest01"
Const NewName = "usertest001"
Dim WshShell, strEnvDnsDomain, arrItem
Dim baseDN, objRootDSE
Dim objConnection, objCommand, strCommandText
Dim objRecordSet, strUserDN
Dim objUser, objPOU, objNewUser
Dim i
baseDN = ""

' DNSドメインを取得しbaseDNを設定
Set WshShell = CreateObject("WScript.Shell")
strEnvDnsDomain = WshShell.ExpandEnvironmentStrings("%USERDNSDOMAIN%")
strEnvDnsDomain = LCase(strEnvDnsDomain)
If Left(strEnvDnsDomain, 1) = "%" Then
  WScript.Echo "操作しているPCはActive Directoryドメインに参加していないようです。" & vbNewLine & _
		"終了します。"
  WScript.Quit
End If
arrItem = Split(strEnvDnsDomain, ".")
baseDN = ""
For i = 0 to UBound(arrItem)
  If i = 0 Then
    baseDN = "DC=" & arrItem(i)
  Else
    baseDN = baseDN & ",DC=" & arrItem(i)
  End If
Next

' DCに接続して検索
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
strCommandText = "<LDAP://" & baseDN & ">;" & _
	"(&(objectClass=user)(sAMAccountName=" & OldName & "));" & _
	"distinguishedName;" & _
	"subtree"
objCommand.CommandText = strCommandText
Set objRecordSet = objCommand.Execute

' 設定変更
If objRecordset.EOF Then
  strUserDN = "ログオンアカウント " & OldName & " は見つかりませんでした。"
Else
  strUserDN = objRecordset.Fields("distinguishedName")
  Set objUser = GetObject("LDAP://" & strUserDN)
  Set objPOU = GetObject(objUser.Parent)
  Set objNewUser = objPOU.MoveHere(objUser.ADsPath, "CN=" & NewName)
  objNewUser.GetInfo
  objNewUser.Put "sAMAccountName", NewName
  objNewUser.Put "userPrincipalName", NewName & "@" & strEnvDnsDomain
  objNewUser.Put "sn", NewName
  objNewUser.Put "displayName", NewName
  objNewUser.SetInfo
  WScript.Echo objNewUser.ADsPath
End If
WScript.Echo "END"
objConnection.Close
Set objCommand = Nothing

VBScript で Active Directory ユーザーのCNを変更 | IADsContainer インターフェース | IADsUser インターフェース