Add AD Users to Group based on Company Attribute/Property

Every now and then we need a script from yester-year.  I was never very good with AD and VBscripting but I need a script which would scan the Active Directory Users and add the users to a group depending on which company/organisation they worked for.

I found this and adjusted it in my own environment, but here it is, taken from http://www.experts-exchange.com/Software/Server_Software/File_Servers/Active_Directory/Q_25025446.html

Set oRootDSE = GetObject(“LDAP://RootDSE”)
Set objConn = CreateObject(“ADODB.Connection”)
Set objComm = CreateObject(“ADODB.Command”)
Set objGroupDict = CreateObject(“Scripting.Dictionary”)

objConn.Provider = “ADsDSOObject”
objConn.Open “Active Directory Provider”
Set objComm.ActiveConnection = objConn
objComm.Properties(“Page Size”) = 1000
strBase = “<LDAP://” & oRootDSE.get(“defaultNamingContext”) & “>;”
strAttrs = “distinguishedName;”
strScope = “subtree”

‘ADD THE CODES AND THE DNS FOR YOUR GROUPS HERE…………………….
‘objGroupDict.Add “ABC”, “CN=GroupABC,OU=groups,DC=domain,DC=local”
‘objGroupDict.Add “DEF”, “CN=GroupDEF,OU=groups,DC=domain,DC=local”
‘objGroupDict.Add “GHI”, “CN=GroupGHI,OU=groups,DC=domain,DC=local”
‘objGroupDict.Add “JKL”, “CN=GroupJKL,OU=groups,DC=domain,DC=local”
‘……………………………………………………………..

For Each groupCode In objGroupDict.Keys
strFilter = “(&(objectclass=user)(objectCategory=person)(company=*” & groupCode & “*));”
objComm.CommandText = strBase & strFilter & strAttrs & strScope
Set objRS = objComm.Execute
Set objGroup = GetObject(“LDAP://” & objGroupDict.Item(groupCode))
If objRs.RecordCount > 0 Then
Do Until objRS.EOF
On Error Resume Next
objGroup.Add(“LDAP://” & objRS.Fields(“distinguishedName”).Value)
If Err.Number = -2147019886 Then
‘Do nothing
ElseIf Err.Number<> 0 Then
WScript.Echo Err.Number & “: ” & Err.Description
End If
On Error Goto 0
objRS.MoveNext
Loop
End if
Next