Enumerate Active Directory Group Members

Datamation content and product recommendations are editorially independent. We may make money when you click on links to our partners. Learn More.

Want to share a script? Click here to contribute!

Author:
Shane Boudreaux

Platform:
Windows

Type:
Win

Description:
Script will enumerate group members, based on an Active Directory Group name.

Scroll down to view the script.

Enumerate Active Directory Group Members

''==================================
''  Enumerate Active Directory Group Members
''  Author:		Shane Boudreaux
''  Start Date:		5/22/07
''  Last Modified:	5/22/07
''==================================

''==================================
'' GLOBAL DECLARES & CONSTANTS
''==================================
On Error Resume Next
Const ForAppending = 8
Const DOMAIN = "LDAP://DC=YourDomain,DC=com"
Const GROUPHEADER = "GROUP:"
Const GROUPFOOTER = "====================="

Dim groupName

'' prompt user for FULL group name
groupName = inputbox("Enter Full Group Name")

'' check if output file exists; create if doesn''t exist
fileExists "c:members.txt"

'' find the group and output members to text file
findGroup groupName

wscript.echo "DONE!"
'' display results text file
openFile

''========================
Private Sub findGroup(grp)

	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") = 5000
	objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 

	objCommand.CommandText = "SELECT ''distinguishedName'' FROM ''" & DOMAIN & "'' WHERE objectCategory=''group'' " & _
		"AND Name=''" & grp & "*''"

	Set objRecordSet = objCommand.Execute

	objRecordSet.MoveFirst
	Do Until objRecordSet.EOF
		group = objRecordSet.Fields("distinguishedName").Value
				getMembers group
		objRecordSet.MoveNext
	Loop
End Sub
''========================

''========================
Private Sub getMembers(grp)
	Set objGroup = GetObject ("LDAP://" & grp)
	objGroup.GetInfo
	arrMemberOf = objGroup.GetEx("member")
	text = GROUPHEADER & vbcrlf & vbtab & grp & vbcrlf & GROUPFOOTER & vbcrlf & "MEMBERS:" & vbcrlf & GROUPFOOTER & vbcrlf
	For Each strMember in arrMemberOf
		''Dim temp
		''temp = pwdExpire(strMember)
		''strMember = strMember & vbcrlf & temp
		text = text & strMember & vbcrlf
	Next
	AppendToFile text
End Sub
''========================

''========================
Private Sub AppendToFile(text)
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objFile = objFSO.OpenTextFile("C:members.txt", ForAppending)
	If text  "" Then
		objFile.WriteLine text
	Else
		objFile.WriteLine "No Members OR Incorrect Input"
	End If
	objFile.Close
End Sub
''========================

''========================
Private Sub openFile()
	Const WIN_STYLE = 4
	Set objShell = WScript.CreateObject("WScript.Shell")
	objShell.Run "notepad.exe c:members.txt", WIN_STYLE
End Sub
''========================

''================================
Private Sub fileExists(file)
	'' NOTE: param file must be full path and file name!
	Set objFSO = CreateObject("Scripting.FileSystemObject")

	If objFSO.FileExists(file) Then
Exit Sub
	Else	'' Create File if DOESN''t Exist
Set objFSO = CreateObject("Scripting.FileSystemObject")
		Set objFile = objFSO.CreateTextFile(file)
	End If
End Sub
''================================

''===============================
Private Function pwdExpire(user)
	Const SEC_IN_DAY = 86400
	Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
	Dim retVal
 
	Set objUserLDAP = GetObject("LDAP://" & user)
	intCurrentValue = objUserLDAP.Get("userAccountControl")
 
	If intCurrentValue and ADS_UF_DONT_EXPIRE_PASSWD Then
retVal = vbTab & "Password does NOT expire."
	Else
dtmValue = objUserLDAP.PasswordLastChanged 
retVal = vbTab & "The password was last changed on " & _
DateValue(dtmValue) & " at " & TimeValue(dtmValue) & VbCrLf & _
vbTab & "The difference between when the password was last set" &  _
"and today is " & int(now - dtmValue) & " days"
intTimeInterval = int(now - dtmValue)
  
Set objDomainNT = GetObject("WinNT://its")
intMaxPwdAge = objDomainNT.Get("MaxPasswordAge")
If intMaxPwdAge = intMaxPwdAge Then
  retVal = retVal & vbcrlf & vbtab & vbtab & "The password has expired."
Else
  retVal = retVal & vbcrlf & vbtab & vbtab & "The password will expire on " & _
  DateValue(dtmValue + intMaxPwdAge) & " (" & _
 int((dtmValue + intMaxPwdAge) - now) & " days from today" & _
 ")."
End If
End If
	End If
	pwdExpire = retVal
End Function
''===============================

Disclaimer: We hope that the information in these pages is valuable to you. Your use of the information contained in these pages, however, is at your sole risk. All information on these pages is provided “as -is”, without any warranty, whether express or implied, of its accuracy, completeness, fitness for a particular purpose, title or non-infringement, and none of the third-party products or information mentioned in the work are authored, recommended, supported or guaranteed by me. I shall not be liable for any damages you may sustain by using this information, whether direct, indirect, special, incidental or consequential, even if it has been advised of the possibility of such damages.