学习VBS,自CSV批量修改AD属性.

抄抄改改.

 

 

 

OPTION EXPLICIT
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H0001
Const ADS_PROPERTY_CLEAR = 1
Const ForReading = 1

DIM strSearchAttribute
DIM strCSVHeader, strCSVFile, strCSVFolder
DIM strAttribute(), userPath,strQuery
DIM userChanges
DIM cn,cmd,rs
DIM objSysInfo,objUser
DIM oldVal, newVal
DIM objField
DIM blnSearchAttributeExists
DIM objFSO,objTextFile,csvrow,strNextLine,arrADAtts,FieldNums,SearchFieldNO
redim strAttribute(100,0)
msgbox "**************************************************"&VbCrLf& _
       "******域用戶屬性修改腳本,請以逗號分隔符分割欄位***"&VbCrLf& _
    "******為避免大面積出錯,每次修改不得多于100個******"&VbCrLf& _
    "**************************************************"
'*************************SETUP***************************
strSearchAttribute = "sAMAccountName"
strCSVFolder = "D:"
strCSVFile = "usermod.csv"
'*************************END SETUP***********************
Set objSysInfo = CreateObject("WinNTSystemInfo")

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile _
    (strCSVFolder&strCSVFile, ForReading)
csvrow = 0

Do Until objTextFile.AtEndOfStream
    strNextLine = objTextFile.Readline
    arrADAtts = Split(strNextLine , ",")
 blnSearchAttributeExists=false
 for FieldNums = 0 to Ubound(arrADAtts) 
 strAttribute(csvrow,FieldNums) = arrADAtts(FieldNums)
 wscript.echo "("&csvrow&","&FieldNums&"):"&strAttribute(csvrow,FieldNums)&",此欄位名為："&strAttribute(0,FieldNums)
 If csvrow = 0 Then
 redim preserve strAttribute(100,FieldNums+1)
   if UCASE(arrADAtts(FieldNums)) = UCASE(strSearchAttribute) then
   blnSearchAttributeExists=True
   SearchFieldNO = FieldNums
   end If

 Elseif csvrow > 99 then
 wscript.echo "別瞎搞了，一次搞100個帳號還不夠啊！"
 wscript.quit
 else
 userPath = getUser(strSearchAttribute,arrADAtts(SearchFieldNO))
 if FieldNums = SearchFieldNO then
 else
  if LEFT(userPath,6) = "Error:" then
   wscript.echo userPath
  else
   set objUser = getobject(userpath)
    userChanges = 0 
    oldval = ""     
    newval = ""
    if UCASE(strAttribute(csvrow,FieldNums)) <> "NULL" and UCASE(strAttribute(csvrow,FieldNums)) <>strAttribute(0,FieldNums) then
     newVal = arrADAtts(FieldNums) ' Get new attribute value from CSV file
'     wscript.echo "newVal:"&newval
      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(csvrow,FieldNums) = "cn" then
       newVal = REPLACE(newVal,",","\,")
      end If
     ' Read the current value before changing it
     readAttribute strAttribute(0,FieldNums) 'strAttribute
'     wscript.echo "oldval:"&oldval    
     ' Check if the new value is different from the update value
      if oldval <> newval then
       wscript.echo "Change " & strAttribute(0,FieldNums) & " from '" & oldVal & "' to '" & newVal & "'"
       ' Update attribute
       writeAttribute strAttribute(0,FieldNums),newVal
       ' Used later to check if any changes need to be committed to AD
        readAttribute "info"
        newVal=oldval&VbCrLf&date&",由"&objSysInfo.Username&"修改:"&strAttribute(0,FieldNums)
        writeAttribute "info",newVal
       userChanges = userChanges + 1
      end If
    end If

  ' 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
 end if
  userPath = ""
    End if 
next

 if csvrow =0 and 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

 
 
 
 
 csvrow = csvrow + 1
Loop

 

 

Sub readAttribute(ByVal strQuery)
 Select Case LCASE(strQuery)
  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(strQuery)
   WScript.Echo ".............oldVal:"&oldVal
   WScript.Echo "要讀取的欄位:"&strQuery
   On Error goto 0
 End Select
End Sub
' updates the specified attribute
Sub writeAttribute(ByVal strQuery,newVal)
 Select Case LCASE(strQuery)
  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, "manager", 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, strQuery, Null
   Else
    objUser.put strQuery,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=";" & _
   "(&(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