Microsoft Exchange Address List Segregation - Script to bulk update msExchQueryBaseDN

Some time ago, I have been helping a customer utilize "Address list segregation whitepaper” from Microsoft to implement in their organization. The customer had implemented each company users’ in independent Organizational Units (OU) and was looking for a way to update the msExchQueryBaseDN per each organizational Unit. The PowerShell command, they had, didn’t work. I suggested them to use the below script to update based on the organizational Unit (OU) and I believe it can help other customers using the Address list segregation. Just change the OU name in the below script and save it as .vbs file and you are good to go.

 

'On Error Resume Next

 

Const ADS_SCOPE_SUBTREE = 2

 

Set objConnection = CreateObject("ADODB.Connection")

Set objCommand = CreateObject("ADODB.Command")

objConnection.Provider = "ADsDSOObject"

objConnection.Open "Active Directory Provider"

Set objCommand.ActiveConnection = objConnection

 

objCommand.Properties("Page Size") = 1000

objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

 

objCommand.CommandText = _

    "SELECT * FROM 'LDAP://OU=LAN,DC=moinic,DC=com' WHERE objectCategory='user'"

Set objRecordSet = objCommand.Execute

i = 0

 

objRecordSet.MoveFirst

Do Until objRecordSet.EOF

                strADsPathUser = objRecordSet.Fields("ADsPath").Value

                Set objUser = GetObject(strADsPathUser)

               

                'If IsEmpty(objUser.msEXCHQueryBaseDN) or IsNull(objUser.msEXCHQueryBaseDN) Then

    objUser.msEXCHQueryBaseDN="OU=LAN,DC=moinic,DC=com"

                                objUser.SetInfo 'Set information on the user

                                wscript.echo objuser.distinguishedname

                                i = i + 1

                'End If

    objRecordSet.MoveNext

Loop

wScript.echo "Script Finished, No Of Users Modified= " & i