In large organisations users frequently change departments.
As a consequence the group memberships of the user have to change also.
Often this is achieved by using an example user.
When the example user has a lot of memberships this can be a time consuming task.
This script asks for the smtp address of the user that has to be changed,
then for the smtp address of the example user.
The function GetDN does a lookup in Active Directory for the distinguished name
of both users.
Then the old group memberships of the user are removed.
At last the group memberships of the example user are added.

Follow the next steps to run the script (admin rights needed):

• open your favorite text editor
• copy and paste the script into the editor
• save the script (for example c:tempchangegroupmemberships.vbs)
• open a command prompt with administrative rights
• go to “c:temp”
• give “cscript changegroupmemberships.vbs” (without quotes) and enter
• in the input box fill in the smtp address of the user that has to be changed
• in the next input box fill in the smtp address of the example user
• give “ok”

The script:

' Name : changegroupmemberships.vbs
' Description : script to change group memberships based on example user
' Author : dirk adamsky - deludi bv
' Version : 1.01
' Date : 16-01-2010

strChangeUser = InputBox("Fill in the SMTP address of the user that has to be changed")
strVoorbeeldUser = InputBox("Fill in the SMTP address of the example user")
strChangeUserDN = GetDN(strChangeUser)
strVoorbeeldUserDN = GetDN(strVoorbeeldUser)
Removegroups strChangeUserDN
Addgroups strChangeUserDN, strVoorbeeldUserDN

Function GetDN(strMail)

    Set adoCommand = CreateObject("ADODB.Command")
    Set adoConnection = CreateObject("ADODB.Connection")
    adoConnection.Provider = "ADsDSOObject"
    adoConnection.Open "Active Directory Provider"
    adoCommand.ActiveConnection = adoConnection

    ' Search entire Active Directory domain.
    Set objRootDSE = GetObject("LDAP://RootDSE")
    strDNSDomain = objRootDSE.Get("defaultNamingContext")
    strBase = "<LDAP://" & strDNSDomain & ">"

    ' Filter on user objects.
    strFilter = "(&(objectCategory=person)(objectClass=user)(mail=" &  strMail & "))"

    ' Comma delimited list of attribute values to retrieve.
    strAttributes = "distinguishedName"

    ' Construct the LDAP syntax query.
    strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
    adoCommand.CommandText = strQuery
    adoCommand.Properties("Page Size") = 100
    adoCommand.Properties("Timeout") = 30
    adoCommand.Properties("Cache Results") = False

    ' Run the query.
    Set adoRecordset = adoCommand.Execute
    GetDN = adoRecordset.Fields("distinguishedName").Value
    ' Clean up.
    adoRecordset.Close
    adoConnection.Close

    Set adoRecordset = Nothing
    Set objRootDSE = Nothing
    Set adoConnection = Nothing
    Set adoCommand = Nothing

End Function

Sub Removegroups(strUserDN)
    Const ADS_PROPERTY_DELETE = 4
    Set objUser = GetObject("LDAP://" & strUserDN)
    If Ubound(objUser.memberOf) <> "" Then
        arrMemberOf = objUser.GetEx("memberOf")
        For Each Group in arrMemberOf
            Set objGroup = GetObject("LDAP://" & Group)
            objGroup.PutEx ADS_PROPERTY_DELETE, "member", Array(strUserDN)
            objGroup.SetInfo
            Set objGroup = Nothing
        Next
    End If
End Sub

Sub Addgroups(strChangeDN,strVBDN)
    On Error Resume Next
    Set objUser = GetObject("LDAP://" & strVBDN)
    arrMemberOf = objUser.GetEx("memberOf")
    For Each Group in arrMemberOf
        Set objGroup = GetObject("LDAP://" & Group)
        objGroup.Add("LDAP://" & strChangeDN)
        objGroup.SetInfo
        Set objGroup = Nothing
    Next
End Sub