' **********************************************************
' Kopieer leden van een AD-groep naar een andere AD-groep
'
' Auteur: Ivo Dijkgraaf
' Datum: 05-03-2012
'
' Historie: 05-03-2012 ID - Initieel
'
' **********************************************************
On Error Resume Next
Dim intMemberCount
strSourceGroupDN = "CN=GAP_VA_FireFox,OU=Virtuele Applicaties,OU=Groups,OU=Reaal,OU=Bedrijven,DC=VERZ-O,DC=O"
''strSourceGroupDN = InputBox ("Enter the DN of Source Group")
strDestGroupDN = "CN=GAP_VA_Google_Chrome,OU=Virtuele Applicaties,OU=Groups,OU=Reaal,OU=Bedrijven,DC=VERZ-O,DC=O"
''strDestGroupDN = InputBox ("Enter the DN of Destination Group")
Set dicSeenGroupMember = CreateObject("Scripting.Dictionary")
Set objDestGroup = GetObject("LDAP://" & strDestGroupDN)
If Err.Number <> vbEmpty Then
Call ErrorHandler("Could not get Destination Group.")
End If
DisplayMembers "LDAP://" & strSourceGroupDN, dicSeenGroupMember
If Err.Number <> vbEmpty Then
Call ErrorHandler("Could not get Group Members.")
End If
Function DisplayMembers (strGroupADsPath, dicSeenGroupMember)
Set objGroup = GetObject(strGroupADsPath)
intMemberCount = 0
For Each objMember In objGroup.Members
On Error Resume Next
objDestGroup.Add("LDAP://" & objMember.distinguishedName)
If Err.Number <> vbEmpty Then
Call ErrorHandler("Could not add member to group.")
Else
intMemberCount = intMemberCount + 1
End If
Next
End Function
MsgBox intMemberCount & " Group Members have been copied to Destination Group"
'****************************************************************
' This function handles errors that occur in the script.
'****************************************************************
Sub ErrorHandler( errorText )
WScript.Echo(vbcrlf & errorText)
WScript.Echo("Error number: " & Err.number)
WScript.Echo("Error Description: " & Err.Description)
Err.Clear
End Sub