批量修改AD账户与属性

以下内容是用来修改用户CN的方法，你也可以用来修改别的属性。建议先在实验环境中使用：

为了满足您修改commonName值的需求，我们认为只有MoveHere方法才能做到这一点。基于此，我找到了一个比较合适的VBS脚本并进行了一点修改。您可以按照我以下的实验步骤尝试一下。请务必在您的实验环境里充分测试之后再在现实环境中使用该脚本。

实验目标

建立5个账户来进行实验，命名为Old Name 01 – Old Name 05。他们的DN名称为：CN=Old Name 0x,OU=UpdateTest, DC=xichen, DC=lab

我们的实验目的，是将他们批量更新为New Name 01 – New Name 05。他们的DN名称为：CN=New Name 0x,OU=UpdateTest, DC=xichen, DC=lab

实验脚本

1.       用来提取用户属性信息到xls文件的exportUserProfile.vbs；

2.       用来修改用户属性信息的UserMod.vbs。

两个脚本如后文所示。

实验步骤

1.       将usermod.vbs放在C盘根目录下。

a.        使用exportUserProfile.vbs脚本，导出用户属性列表到C:\temp\MyExport.xls。如下图：

2.       选择一个可供脚本搜索唯一列，做为更改CN的依据，比如，我们在这里选定userPrincipalName做为该参考列。如果您希望使用别的值做为参考列，请修改usermod.vbs脚本的strSearchAttribute属性

3.       按照以下方式处理MyExport.xls文件：

a.        删除无关行，以排除更名对其它账户的影响。（注：这一步骤很重要，如果您留下了不希望修改的账户，并将cn列留空，它们将被修改成空的cn值）

b.       增加一列，叫cn。在该列中书写您希望改变的目标cn名称，在这里，我们设成New Name 01 – New Name 05

c.        把文件另存为CSV(Comma delimited)格式，放在C盘根目录位置。（C:\usermod.csv） 

4.       在64位的Windows Server 2008 R2环境下，以管理员权限打开命令行提示，并进入C:\Windows\SysWOW64\ 目录。

5.       执行cscript C:\usermod.vbs，会看到更名的执行结果。

6.       如果您还希望相应地修改其它属性，也可以按照以上方式重复操作，或者直接在csv文件中加入对其它属性的修改（参考列除外）。但是，如果您希望修改参考列，如本实验中的userPrincipalName，请先修改usermod.vbs脚本的strSearchAttribute为其它的唯一列。此外，请注意选择参考列的原则：

a.        值是唯一的。

b.       AD Schema中存在的。

c.        Ldap缩写形式，比如Common-Name应该写成cn。更多请参考：http://msdn.microsoft.com/en-us/library/ms675090(v=VS.85).aspx

附脚本：

（1）     导出脚本  exportUserProfile.vbs

SET objRootDSE = GETOBJECT("LDAP://RootDSE")

strExportFile = "C:\temp\MyExport.xls" 

strRoot = objRootDSE.GET("DefaultNamingContext")

strfilter = "(&(objectCategory=Person)(objectClass=User))"

strAttributes = "sAMAccountName,userPrincipalName,givenName,sn," & _

                                "initials,displayName,physicalDeliveryOfficeName," & _

                                "telephoneNumber,mail,wWWHomePage,profilePath," & _

                                "scriptPath,homeDirectory,homeDrive,title,department," & _

                                "company,manager,homePhone,pager,mobile," & _

                                "facsimileTelephoneNumber,ipphone,info," & _

                                "streetAddress,postOfficeBox,l,st,postalCode,c"

strScope = "subtree"

SET cn = CREATEOBJECT("ADODB.Connection")

SET cmd = CREATEOBJECT("ADODB.Command")

cn.Provider = "ADsDSOObject"

cn.Open "Active Directory Provider"

cmd.ActiveConnection = cn

cmd.Properties("Page Size") = 1000

cmd.commandtext = "<LDAP://" & strRoot & ">;" & strFilter & ";" & _

                                   strAttributes & ";" & strScope

SET rs = cmd.EXECUTE

SET objExcel = CREATEOBJECT("Excel.Application")

SET objWB = objExcel.Workbooks.Add

SET objSheet = objWB.Worksheets(1)

FOR i = 0 To rs.Fields.Count - 1

                objSheet.Cells(1, i + 1).Value = rs.Fields(i).Name

                objSheet.Cells(1, i + 1).Font.Bold = TRUE

NEXT

objSheet.Range("A2").CopyFromRecordset(rs)

objWB.SaveAs(strExportFile)

rs.close

cn.close

SET objSheet = NOTHING

SET objWB =  NOTHING

objExcel.Quit()

SET objExcel = NOTHING

Wscript.echo "Script Finished..Please See " & strExportFile

（2）     修改脚本usermod.vbs

OPTION EXPLICIT ' Variables must be declared

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

' * Instructions

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

' Edit the variables in the "Setup" section as required.

' Run this script from a command prompt in cscript mode.

' e.g. cscript usermod.vbs

' You can also choose to output the results to a text file:

' cscript usermod.csv >> results.txt

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

' * Constants / Decleration

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

Const adOpenStatic = 3

Const adLockOptimistic = 3

Const adCmdText = &H0001

Const ADS_PROPERTY_CLEAR = 1

DIM strSearchAttribute

DIM strCSVHeader, strCSVFile, strCSVFolder

DIM strAttribute, userPath

DIM userChanges

DIM cn,cmd,rs

DIM objUser

DIM oldVal, newVal

DIM objField

DIM blnSearchAttributeExists

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

' * Setup

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

' The Active Directory attribute that is to be used to match rows in the CSV file to

' Active Directory user accounts.  It is recommended to use unique attributes.

' e.g. sAMAccountName (Pre Windows 2000 Login) or userPrincipalName

' Other attributes can be used but are not guaranteed to be unique.  If multiple user

' accounts are found, an error is returned and no update is performed.

strSearchAttribute = "userPrincipalName"

' Folder where CSV file is located

strCSVFolder = "C:\"

' Name of the CSV File

strCSVFile = "usermod.csv"

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

' * End Setup

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

' Setup ADO Connection to CSV file

Set cn = CreateObject("ADODB.Connection")

Set rs = CreateObject("ADODB.Recordset")

cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _

          "Data Source=" & strCSVFolder & ";" & _

          "Extended Properties=""text;HDR=YES;FMT=Delimited"""

rs.Open "SELECT * FROM [" & strCSVFile & "]", _

          cn, adOpenStatic, adLockOptimistic, adCmdText

' Check if search attribute exists

blnSearchAttributeExists=false

for each objField in rs.Fields

   if UCASE(objField.Name) = UCASE(strSearchAttribute) then

            blnSearchAttributeExists=true

   end if

Next

if blnSearchAttributeExists=false then

   MsgBox "'" & strSearchAttribute & "' attribute must be specified in the CSV header." & _

            VbCrLf & "The attribute is used to map the data the csv file to users in Active Directory.",vbCritical

   wscript.quit

end if

' Read CSV File

Do Until rs.EOF

   ' Get the ADsPath of the user by searching for a user in Active Directory on the search attribute

   ' specified, where the value is equal to the value in the csv file.

   ' e.g. LDAP://cn=user1,cn=users,dc=wisesoft,dc=co,dc=uk

   userPath = getUser(strSearchAttribute,rs(strSearchAttribute))

   ' Check that an ADsPath was returned

   if LEFT(userPath,6) = "Error:" then

            wscript.echo userPath

   else

            wscript.echo userPath

            ' Get the user object

            set objUser = getobject(userpath)

            userChanges = 0

            ' Update each attribute in the CSV string

            for each objField in rs.Fields

                     strAttribute = objField.Name

                     oldval = ""

                     newval = ""

                     ' Ignore the search attribute (this is used only to search for the user account)

                     if UCASE(strAttribute) <> UCASE(strSearchAttribute) and UCASE(strAttribute) <> "NULL" then

                               newVal = rs(strAttribute) ' Get new attribute value from CSV file

                               if ISNULL(newval) then

                                        newval = ""

                               end If

                               ' Special handling for common-name attribute. If the new value contains

                               ' commas they must be escaped with a forward slash.

                               If strAttribute = "cn" then

                                        newVal = REPLACE(newVal,",","\,")

                               end If

                               ' Read the current value before changing it

                               readAttribute strAttribute

                               ' Check if the new value is different from the update value

                               if oldval <> newval then

                                        wscript.echo "Change " & strAttribute & " from '" & oldVal & "' to '" & newVal & "'"

                                        ' Update attribute

                                        writeAttribute strAttribute,newVal

                                        ' Used later to check if any changes need to be committed to AD

                                        userChanges = userChanges + 1

                               end If

                     end If

            next

            ' Check if we need to commit any updates to AD

            if userChanges > 0 then

                     ' Allow script to continue if an update fails

                     on error resume next

                     err.clear

                     ' Save Changes to AD

                     objUser.setinfo

                     ' Check if update succeeded/failed

                     if err.number <> 0 then

                               wscript.echo "Commit Changes: Failed. " & err.description

                               err.clear

                     else

                               wscript.echo "Commit Changes: Succeeded"

                     end if

                     on error goto 0

            else

                     wscript.echo "No Changes"

            end if

   end If

           userPath = ""

    rs.MoveNext

Loop

' Cleanup

rs.close

cn.close

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

' * End of script

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

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

' * Functions

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

' Reads specified attribute and sets the value for the oldVal variable

Sub readAttribute(ByVal strAttribute)

   Select Case LCASE(strAttribute)

            Case "manager_samaccountname"

                     ' special handling to allow update of manager attribute using sAMAccountName (UserName)

                     ' instead of using the distinguished name

                     Dim objManager, managerDN

                     ' Ignore error if manager is null

                     On Error Resume Next

                     managerDN = objUser.Get("manager")

                     On Error GoTo 0

                     If managerDN = "" Then

                               oldVal=""

                     Else

                               Set objManager = GetObject("LDAP://" & managerDN)

                               oldVal = objManager.sAMAccountName

                               Set objManager=Nothing

                     End If

            Case "terminalservicesprofilepath"

                     'Special handling for "TerminalServicesProfilePath" attribute

                     oldVal=objUser.TerminalServicesProfilePath

            Case "terminalserviceshomedirectory"

                     'Special handling for "TerminalServicesHomeDirectory" attribute

                     oldVal = objUser.TerminalServicesHomeDirectory

            Case "terminalserviceshomedrive"

                     'Special handling for "TerminalServicesHomeDrive" attribute

                     oldVal=objUser.TerminalServicesHomeDrive

            Case "allowlogon"

                     ' Special handling for "allowlogon" (Terminal Services) attribute

                     ' e.g. 1=Allow, 0=Deny

                     oldVal=objUser.AllowLogon

            Case "password"

                     ' Password can't be read, just return ****

                     oldVal="****"

            Case Else

                     on error resume next ' Ignore error if value is null

                     ' Get old attribute value

                     oldVal = objUser.Get(strAttribute)

                     On Error goto 0

   End Select

End Sub

' updates the specified attribute

Sub writeAttribute(ByVal strAttribute,newVal)

   Select Case LCASE(strAttribute)

            Case "cn" 'Special handling required for common-name attribute

                     DIM objContainer

                     set objContainer = GetObject(objUser.Parent)

                     on error resume Next

                     objContainer.MoveHere objUser.ADsPath,"cn=" & newVal

                     ' The update might fail if a user with the same common-name exists within

                               ' the same container (OU)

                     if err.number <> 0 Then

                               wscript.echo "Error changing common-name from '" & oldval & "' to '" & newval & _

                                                      "'.  Check that the common-name is unique within the container (OU)"

                               err.clear

                     End If

                     on Error goto 0

            Case "terminalservicesprofilepath"

                     'Special handling for "TerminalServicesProfilePath" attribute

                     objUser.TerminalServicesProfilePath=newVal

            Case "terminalserviceshomedirectory"

                     'Special handling for "TerminalServicesHomeDirectory" attribute

                     objUser.TerminalServicesHomeDirectory=newVal

            Case "terminalserviceshomedrive"

                     'Special handling for "TerminalServicesHomeDrive" attribute

                     objUser.TerminalServicesHomeDrive=newVal

            Case "allowlogon"

                     ' Special handling for "allowlogon" (Terminal Services) attribute

                     ' e.g. 1=Allow, 0=Deny

                     objUser.AllowLogon=newVal

            Case "password"

                     ' Special handling for setting password

                     objUser.SetPassword newVal

            Case "manager_samaccountname"

                     ' special handling to allow update of manager attribute using sAMAccountName (UserName)

                     ' instead of using the distinguished name

                     If newVal = "" Then

                               objUser.PutEx ADS_PROPERTY_CLEAR, strAttribute, Null

                     Else

                               Dim objManager, managerPath, managerDN

                               managerPath = GetUser("sAMAccountName",newVal)

                               If LEFT(managerPath,6) = "Error:" THEN

                                        wscript.echo "Error resolving manager DN:" & managerPath

                               Else

                                        SET objManager = GetObject(managerPath)

                                        managerDN = objManager.Get("distinguishedName")

                                        Set objManager = Nothing

                                        objUser.Put "manager",managerDN

                               End If

                     End If      

            Case ELSE ' Any other attribute

                     ' code to update "normal" attribute

                     If newVal = "" then

                               ' Special handling to clear an attribute

                               objUser.PutEx ADS_PROPERTY_CLEAR, strAttribute, Null

                     Else

                               objUser.put strAttribute,newVal

                     End If

   End Select

End Sub

' Function to return the ADsPath of a user account by searching

' for a particular attribute value

' e.g. LDAP://cn=user1,cn=users,dc=wisesoft,dc=co,dc=uk

Function getUser(Byval strSearchAttribute,strSearchValue)

   DIM objRoot

   DIM getUserCn,getUserCmd,getUserRS

   on error resume next

   set objRoot = getobject("LDAP://RootDSE")

   set getUserCn = createobject("ADODB.Connection")

   set getUserCmd = createobject("ADODB.Command")

   set getUserRS = createobject("ADODB.Recordset")

   getUserCn.open "Provider=ADsDSOObject;"

   getUserCmd.activeconnection=getUserCn

   getUserCmd.commandtext="<LDAP://" & objRoot.get("defaultNamingContext") & ">;" & _

                     "(&(objectCategory=person)(objectClass=user)(" & strSearchAttribute & "=" & strSearchValue & "));" & _

                     "adsPath;subtree"

   set getUserRs = getUserCmd.execute

   if getUserRS.recordcount = 0 then

            getUser = "Error: User account not found"

   elseif getUserRS.recordcount = 1 then

               getUser = getUserRs(0)

   else

            getUser = "Error: Multiple user accounts found.  Expected one user account."

   end if

   getUserCn.close

end function

备注：红色字体为编写脚本需要替换的AD用户指定属性列

特别感谢微软陈曦提供此脚本与实验步骤，经测试感觉非常好用，功能强大。