Lister les groupes d'un utilisateur AD

Option Explicit

Dim MyDistinguishedName
Dim objRootDSE, objItem, objConnection, objCommand, objRecordSet, objRecordSetforGroups, MyCommandText
Dim strContainer, strname
Dim sAMAccountName, objUser, objmemberOf, objGroup, objOneGroup

strContainer = "" 'Si vous souhaitez vous connecter à une OU en particulié, indiquez la ici
sAMAccountName = InputBox("Entrez le login de la personne","Login","AdminBis")


Const ADS_UF_ACCOUNTDISABLE = 2 
Const ADS_SCOPE_SUBTREE = 2

If Len(sAMAccountName) > 0 Then
	On Error Resume Next
	Set objRootDSE = GetObject("LDAP://rootDSE")
	If strContainer = "" Then
	  Set objItem = GetObject("LDAP://" & objRootDSE.Get("defaultNamingContext"))
	Else
	  Set objItem = GetObject("LDAP://" & strContainer & "," & _
		objRootDSE.Get("defaultNamingContext"))
	End If
	On Error Goto 0

	'strname = objItem.Get("name")
	'WScript.Echo "name: " & strname

	MyDistinguishedName = objItem.Get("distinguishedName") 'Récupération du distinguishedName du domaine par défaut. Exemple DC=Cotonso,DC=Com
	'WScript.Echo "distinguishedName: " & MyDistinguishedName

	Set objConnection = CreateObject("ADODB.Connection") 
	objConnection.Open "Provider=ADsDSOObject;" 
	Set objCommand = CreateObject("ADODB.Command") 
	objCommand.ActiveConnection = objConnection 
	objCommand.CommandText = "<LDAP://" & MyDistinguishedName & ">;(&(objectCategory=User)(sAMAccountName=" & sAMAccountName & "));name,cn,displayName,sn,sAMAccountName,distinguishedName,memberof;subtree"

	objCommand.Properties("Page Size") = 10000
	objCommand.Properties("Timeout") = 30
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
	objCommand.Properties("Cache Results") = False

	Set objRecordSet = objCommand.Execute 
	Do Until objRecordset.EOF 
		'WScript.echo objRecordset.Fields("distinguishedName")
		WScript.echo "Name : " & VbTab & objRecordset.Fields("Name")
		WScript.echo VbTab & "cn : " & VbTab & objRecordset.Fields("cn")
		WScript.echo VbTab & "displayName : " & VbTab & objRecordset.Fields("displayName")
		WScript.echo VbTab & "sn : " & VbTab & objRecordset.Fields("sn")
		WScript.echo VbTab & "sAMAccountName : " & VbTab & objRecordset.Fields("sAMAccountName")
		WScript.echo VbTab & "distinguishedName : " & VbTab & objRecordset.Fields("distinguishedName")
		WScript.echo ""

		objmemberOf = objRecordset.Fields("memberof")
		If IsNull(objmemberOf) Then
		Else
			For Each objGroup in objmemberOf
				'Wscript.echo "Connexion à : " & objGroup
				Set objOneGroup = GetObject("LDAP://" & objGroup)
				WScript.echo VbTab & objOneGroup.sAMAccountName
				Set objOneGroup = Nothing
			Next
		End If
		
		objRecordset.MoveNext
	Loop
	objRecordSet.Close
	objConnection.Close
Else
	Wscript.echo "Login vierge : Arrêt"
End If