VBスクリプトで任意のユーザがActive Directory上で所属する全てのグループを取得する方法

若干作りが雑ですが、Active Directory上の所属グループを取得するスクリプトです。
グループにネストする形でどんどんグループを追加していくと、後々メンテナンスが結構ややこしいです。
そんな場合に実際に所属するグループを全て摘出する事で、ある程度整理を付けることが出来ます。

出力結果をデータベースに入れるように作るとさらに便利に使えます。

過去に作成したADからグループを取得するスクリプトはプライマリグループの取得が抜けていましたが、こちらはプライマリグループも取得出来ます。
プライマリグループの取得方法については、このへんを参考にさせてもらいました。

イメージとしては、Vista以降のwhoamiコマンドで取得出来るグループ一覧に近いものが出力出来ます。
自分は実際のところ、先にリストを作りたいDNのリストを作り、その結果を夜間タスクスケジューラでスケジューリングしてデータベース上に保存しています。

スクリプト中の以下の部分にはユーザのDNを入力する必要があります。

DN = "CN=pnpk,OU=User,DC=pnpk,DC=local"

また、以下の箇所も動作させるドメインによって書き換える必要があります。

"<LDAP://dc=pnpk,dc=local>;(objectCategory=Group);"

Option Explicit

Call Main()

Sub Main()
	Dim DN
	Dim sAMAccountName
	
	'全てのグループを表示させたいユーザのDNを入力
	DN = "CN=pnpk,OU=User,DC=pnpk,DC=local"

	'UserのsAMAccountNameを取得
	sAMAccountName = GET_sAMAccountName(DN)
	'QUERY_PRIMARY_GROUPの呼び出し
	Call ShowStatus(DN,sAMAccountName)
	'QUERY_PRIMARY_GROUPの呼び出し
	Call QUERY_PRIMARY_GROUP(DN,sAMAccountName)
End Sub

Function GET_sAMAccountName(DN)
	Dim adsUser
	Set adsUser = GetObject("LDAP://" & DN )
	If adsUser.Class = "user" Then
		GET_sAMAccountName=adsUser.sAMAccountName
	End If
End Function

Function ShowStatus(DN,sAMAccountName)
	Dim adsGroup
	Dim adsMemberGroup
	
	Set adsGroup = GetObject("LDAP://" & DN )
	If adsGroup.Class = "group" Then
		Wscript.Echo sAMAccountName & " " & Mid(adsGroup.Name,4)
	End If

	If IsArray(adsGroup.MemberOf) Then
		For Each adsMemberGroup In adsGroup.MemberOf
			Call ShowStatus(adsMemberGroup,sAMAccountName)
		Next
	ElseIf Not adsGroup.MemberOf = "" Then
		Call ShowStatus(adsGroup.MemberOf,sAMAccountName)
	End If
End Function

Function QUERY_PRIMARY_GROUP(DN,sAMAccountName)
	Dim objUser
	Dim intPrimaryGroupID
	Dim objConnection
	Dim objCommand
	DIm objRecordSet
	
	Set objUser = GetObject("LDAP://" & DN )
	intPrimaryGroupID = objUser.Get("primaryGroupID")
	 
	Set objConnection = CreateObject("ADODB.Connection")
	objConnection.Open "Provider=ADsDSOObject;"
	Set objCommand = CreateObject("ADODB.Command")
	objCommand.ActiveConnection = objConnection
	objCommand.CommandText = _
	    "<LDAP://dc=pnpk,dc=local>;(objectCategory=Group);" & _
	        "distinguishedName,primaryGroupToken;subtree"  
	Set objRecordSet = objCommand.Execute
	  
	Do Until objRecordset.EOF
	    If objRecordset.Fields("primaryGroupToken") = intPrimaryGroupID Then
	        Call ShowStatus(objRecordset.Fields("distinguishedName"),sAMAccountName)
	    End If
	    objRecordset.MoveNext
	Loop
	 
	objConnection.Close
End Function