' This script will display the e-mail address of all members of a group
' Does not supported nested group membership
' Script created by Jason Sherry 9/24/01

' This will get the current domain and use it as the default domain

Main ()

Sub Main
  ' This will get the current domain and use it as the default domain
  Set rootDSE = GetObject("LDAP://rootDSE") 
  Domain = rootDSE.Get("defaultNamingContext")
  Dim GroupMembers, GroupMember, oGroup
  Dim t

  '** This script will read in the members of a group and assign them to an array
  '** It will then list the members of the group

  group = InputBox("Please enter the name of the group you want to display the members of","Group name","TestDL")

  ' Get DN of the group, using the samAccountName\pre-Windows 2000 name
  GroupPath = FindObjectPath ("SamAccountName",group,Domain)
  ' If group isn't found, search on DisplayName
  If GroupPath = "" Then GroupPath = FindObjectPath ("DisplayName",group,Domain)
    
  'Bind to the group
  Set oGroup = GetObject(GroupPath)

  For Each member in oGroup.members
    DisplayObject member.ADSPath
  Next
End Sub

Sub DisplayObject (strDNPath)
  On Error Resume Next
  Set objObject = GetObject(strDNPath)

  'Get data for fields

  On Error Resume Next ' If any of these values are Nul it will return and error
  cn = objObject.Get("cn")
  On Error GoTo 0 ' Will stop on errors again
  Emails = ""

  'For each e-mail address add it to the EMails variable
  For Each EMail In objObject.GetEx("proxyAddresses")
	  If Len(SMTPEMails) > 0 Then
		  Extra = VBCrLf & Space (6)
		  Else
			  Extra = ""
	  End If
	  If UCase(Left(EMail,4)) = "SMTP" Then
		  SMTPEMails = EMail & Extra & SMTPEMails
		  Else
			  OtherEMails = EMail & Extra & OtherEMails
	  End If
  Next

  'Display current fields
  Wscript.Echo Space(2) & "Name: " & cn & VBCrLf  & _
               Space(4) & "SMTP E-Mails: " & VBCrLf & Space (6) & SMTPEmails & VBCrLf & _
               Space(4) & "Other E-Mails: " & VBCrLf & Space (6) & OtherEmails

  set objObject = nothing
End Sub

Function FindObjectPath (SearchField,SearchFieldValue,SearchDomainDN)
  On Error Resume Next
	Dim ObjDBConnection, objCommand, objResults
	Dim SQLString

	FindObjectPath = ""
	Set ObjDBConnection = CreateObject("ADODB.Connection")
	Set objCommand = CreateObject("ADODB.Command")
	ObjDBConnection.Provider = "ADsDSOObject"
	ObjDBConnection.Open "Active Directory Provider"
	Set objCommand.ActiveConnection = ObjDBConnection
	SearchField = Trim(SearchField)
	SearchFieldValue = Trim(SearchFieldValue)
	SQLString = "SELECT ADsPath FROM 'LDAP://" & SearchDomainDN & "' WHERE " & SearchField & " = '" & SearchFieldValue & "'"
	objCommand.CommandText = SQLString
	On Error Resume Next
	Set objResults = objCommand.Execute
	FindObjectPath = objResults.Fields("ADsPath")
	On Error GoTo 0
	Set objResults = Nothing
	Set objCommand = Nothing
	Set ObjDBConnection = Nothing
End Function