'# From the book "Managing Enterprise Active Directory Services"
'# ISBN: 0-672-32125-4
ON ERROR RESUME NEXT
Dim strADsPath, strUser, strPasswd, strServer
strServer = "dc1"
strUser   = "administrator@xyz.com"
strPasswd = "password"
Dim strCriteria, strProperties, strScope
strCriteria = "(&(objectClass=user)(objectCategory=Person));"
strProperties = "name,ADsPath;"
strScope = "SubTree"
Dim objConnect, objCommand, objRecordSet
Set objConnect = CreateObject("ADODB.Connection")
objConnect.Provider = "ADsDSOObject"
objConnect.Open "Active Directory Provider", strUser, strPasswd
If Err.Number then
    Wscript.Echo "Error occurred opening the provider: " _
                  & Err.Description
    WScript.Quit
End If
Set objCommand = CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnect
objCommand.Properties("Page Size") = 1000
objCommand.CommandText  = "<LDAP://ou=Employees,dc=xyz,dc=com>;" _
                          & strCriteria & strProperties & strScope
'Execute the query
Set objRecordSet = objCommand.Execute
If Err.Number then
    Wscript.Echo "Error occurred during the query: " _
                 & Err.Description
    Wscript.Quit
End If
Dim count
count = 0
objRecordSet.MoveFirst
While Not objRecordSet.EOF
    Wscript.Echo "Updating: " & objRecordSet.Fields(0).Value
    Dim usrADsPath
    usrADsPath = objRecordSet.Fields(1).Value
    Dim ldapObj
    Set ldapObj = GetObject("LDAP:")
    Dim usrObj
    Set usrObj = ldapObj.OpenDsObject(usrADsPath,strUser,strPasswd,1)
    usrObj.Put "division", "XYZ Division"
    usrObj.SetInfo
    count = count + 1
    objRecordSet.MoveNext
Wend
Wscript. Echo "Total: " & count