Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Westi on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Saved query 1

Status
Not open for further replies.

Blutch

IS-IT--Management
Sep 19, 2002
203
BE
Is it possible in ADUC (using saved queries) to have a query which lists me all the users who belong to a specific group or specific groups.

Any help is appreciated

Thx
 
Try google [vbscript export group members]
 
I was looking through my scripts and found 2 you might find useful, for the first one you may want to lookup f.writeline for some output file.
Seems as the second one is long I'll create another post

Code:
Dim Group, GroupName, GroupDomain, objArgs
Dim objDict, userName

GroupName = InputBox("Enter in Group name.")
GroupDomain= InputBox("Enter your Domain name.", "Or set it in the script")

Set objDict = CreateObject("Scripting.Dictionary")
Set Group = GetObject("WinNT://" & GroupDomain & "/" & GroupName & ",group")

For Each Member in Group.Members
 objDict.Add Member.Name, ""
Next

For Each userName In objDict.Keys
WScript.Echo userName
Next
 
second one
Code:
'\\\\\\
'\\
'\\ Filter AD groups, select a AD group and make a list of its users
'\\ Frans Erich 16-02-06
'\\
'\\         Sub : CheckForUser and GetUserAccount taken from "ADuser" script from Ralph E Montgomery
'\\         Function : SelectBox taken from script from T. Lavedas
'\\
'\\ Script only works in a domain environment
'\\
'\\\\\\\

Dim objGroup, objUser, WshShell, strMessage, strDomain, strUserMail, strRootDSE, strGetUserName, Ouser, fso
Dim objNet, major, minor, ver, strMail, strLogonName, strValue, strDisplayDescription, strDisplayDepartment, strDN
Dim strSearch, strMostRecentIP, aOpt(), intOpt, oGroup, sGroup, txtFile, objComputer
Dim objRootDSE, strTemp, strADsConfPath, strFormat, strFile, i, objConnection, objCommand, objRecordSet, objectRecordSet
Dim strKey, strKeyValue, rval, strBCC, oMailApp, olMailItm, olMailItem, intSize, strDelegateCount

Set WshShell = WScript.CreateObject("WScript.Shell")
Set objNet = CreateObject("WScript.Network")
Set objRootDSE = GetObject("LDAP://rootDSE")
strADsConfPath = "LDAP://" & objRootDSE.Get("configurationNamingContext")
strRootDSE = objRootDSE.Get("defaultNamingContext")
strDomain = UCase(objNet.UserDomain)
'strSearch = LCase(InputBox("Give a name of a Group."))
ListGroups( strDomain )
intOpt = 1
sGroup = SelectBox("Select a Group", aOpt)
' Change the value of variable "strFormat" to Outlook to generate a new mail containing all email addresses of the mebers in the BCC box.
strFormat = "Excel"

Set oGroup = GetObject("WinNT://" & strDomain & "/" & sGroup & ",group")
if sgroup <> "Aborted" then
if sgroup <> "Select a Group" then
if strFormat = "Excel" then
strTemp = WshShell.ExpandEnvironmentStrings("%temp%")
strFile = strTemp & "\List " & sgroup & ".csv"
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(strFile) Then
fso.DeleteFile(strFile)
End If
Set txtFile = fso.CreateTextFile(strFile)
i = 0
For Each oUser In oGroup.Members
i = i + 1
strGetUserName=""
strDN=""
strMail=""
strGetUserName= UCase(oUser.Name)
while strDN=""
CheckForUser()
Wend
GetUserAccount(strDN)
txtFile.write (oUser.Name & " ; " & strDisplayDepartment & " ; " & strMail & vbCrLf)
Next
txtfile.close
Set txtfile = nothing
Set fso = nothing
strKey = "HKLM\Software\Microsoft\Windows\CurrentVersion\App Paths\Excel.exe\path"
If KeyExists(strKey) = True Then
strKeyValue = WshShell.RegRead(strKey)
rval = WshShell.Run(chr(34) & strKeyValue & "excel.exe" & chr(34) & " " & chr(34) & strFile & chr(34) ,1,TRUE)
else
rval = WshShell.Run("notepad.exe" & " " & strFile,1,TRUE)
end if
else
For Each oUser In oGroup.Members
i = i + 1
strGetUserName=""
strDN=""
strMail=""
strGetUserName= UCase(oUser.Name)
while strDN=""
CheckForUser()
Wend
GetUserAccount(strDN)
strBCC = strBCC & strMail &"; "
Next
Set oMailApp = CreateObject("Outlook.Application")
Set olMailItm = oMailApp.CreateItem(olMailItem)
olMailItm.BCC = strBCC
olMailItm.Display
end if
end if
end if

Sub CheckForUser()
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = ("ADsDSOObject")
objConnection.Open
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
objCommand.CommandText = _
"<LDAP://" & strRootDSE & ">;(&(objectCategory=User)" & _
"(samAccountName=" & strGetUserName & "));distinguishedName,sAMAccountName,name;subtree"
Set objRecordSet = objCommand.Execute
strDN = objRecordset.Fields("distinguishedName")
Set objectRecordSet = Nothing
objConnection.close
Set objConnection = Nothing

End Sub

Sub GetUserAccount(strDN)
On Error Resume Next
If InStr(1,strDN,"/") Then strDN=Replace(strDN,"/","\/")
Set objUser = GetObject("LDAP://" & strDN & "")
Set objAdS = GetObject("LDAP://" & strRootDSE & "")

With objUser
'.GetInfo
strMail = .Get("mail")
strLogonName = .Get("sAMAccountName")
strUserMail = .Get("mail")
strDescription = .GetEx("description")
strDepartment = .GetEx("department")

strDisplayDepartment=""
For Each strValue in strDepartment
strDisplayDepartment = strDisplayDepartment & strValue
Next

For Each strValue in strDescription
strDisplayDescription = strDisplayDescription & strValue
Next

End With

End Sub

Sub ListGroups( strDomain )
Set objComputer = GetObject("WinNT://" & strDomain )
objComputer.Filter = Array( "Group" )
For Each objGroup In objComputer
if InStr(LCase(objGroup.Name),strSearch) then
ReDim Preserve aOpt(intOpt+ 1)
aOpt(intOpt) = objGroup.Name
intOpt = intOpt + 1
end if
Next
End Sub

Function SelectBox(sTitle, aOptions)
Dim oIE, s, item
set oIE = CreateObject("InternetExplorer.Application")
With oIE
.FullScreen = True
.ToolBar = False : .RegisterAsDropTarget = False
.StatusBar = False : .Navigate("about:blank")
Do Until .ReadyState = 4 : WScript.Sleep 100 : Loop
.width= 400 : .height=200
With .document
with .parentWindow.screen
oIE.left = (.availWidth - oIE.width ) \ 2
oIE.top = (.availheight - oIE.height) \ 2
End With
s = "<html><head><title>" & sTitle _
& "</title></head><script language=vbs>bWait=true<" & "/script>" _
& "<body bgColor=Silver><center>" _
    & "<b>" & sTitle & "<b><p>" _
& "<select id=entries size=1 style='width:325px'>" _
& " <option selected>" & sTitle & "</option>"
For each item in aOptions
s = s & " <option>" & item & "</option>"
Next
s = s & " </select><p>" _
& "<button id=but0 onclick='bWait=false'>OK</button>" _
& "</center></body></html>"
.open
.Write(s)
.close
Do until .ReadyState ="complete" : Wscript.Sleep 50 : Loop
With .body
.scroll="no"
.style.borderStyle = "outset"
.style.borderWidth = "3px"
End With
.all.entries.focus
oIE.Visible = True
CreateObject("Wscript.Shell").AppActivate sTitle
On Error Resume Next
Do While .ParentWindow.bWait
WScript.Sleep 100
if oIE.Visible Then SelectBox = "Aborted"
if Err.Number <> 0 Then Exit Function
Loop
On Error Goto 0
With .ParentWindow.entries
SelectBox = .options(.selectedIndex).text
End With
End With
.Visible = False
End With
End Function


Function KeyExists(sKeyPath)
keyExists= false: if (sKeyPath="") then exit function
on error resume next
createobject("wscript.shell").regRead sKeyPath
select case err
case 0: keyExists= true
case &h80070002: dim sErrMsg
sErrMsg= replace(err.description, sKeyPath, "")
err.clear
createobject("wscript.shell").regRead "HKEY_ERROR\"
keyExists= not (sErrMsg=replace(err.description, "HKEY_ERROR\", ""))
case else: keyExists= false
end select
on error goto 0
End function
 
Thx for the answers.

Maybe my question isn't clear?
I think I have to use the 'saved queries' possibilities in Active Directory Users and Computers, because for the users I get in response of my query I have to change the logon hours by selecting them and changing them in one move.

I think it is difficult to do with scripts (not impossible, but still...)? Can I do it directly in AD?
 
That helps, but is it really not possible to get group membership in ADUC?
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top