excelenergy
Board Regular
- Joined
- Jun 7, 2012
- Messages
- 142
Hello,
I found a script that does, more or less what I need it to with the exception of a few things. The script below
can query active directory, but the issue Im running into is, when running the Macro, I get prompted to enter the name of the group....Is this security group? or outlook group. What Ive done thus far, is found a random user in outlook, opened their contact information > then clicked on the email addresses tab. I took the outlook group name from that tab...entered in this excel sheet and the error I got was, "Nothing Found, Existing"
Really, Im trying to get the script to query the group and list the members, but I just keep getting that error, its like its not querying active directory properly......Any advice on what may need to be altered?
I found a script that does, more or less what I need it to with the exception of a few things. The script below
can query active directory, but the issue Im running into is, when running the Macro, I get prompted to enter the name of the group....Is this security group? or outlook group. What Ive done thus far, is found a random user in outlook, opened their contact information > then clicked on the email addresses tab. I took the outlook group name from that tab...entered in this excel sheet and the error I got was, "Nothing Found, Existing"
Really, Im trying to get the script to query the group and list the members, but I just keep getting that error, its like its not querying active directory properly......Any advice on what may need to be altered?
Rich (BB code):
Sub LDAPQueryDevices()
'****
' VBSCRIPT to interogate AD/LDAP for a given group and report the following
'
' 1) tally of the number of members of the given group
' 2) list user details against group
'
' Author Jim Ward
' Creation 27th May 2011
'
' Gleaned from various sources and assembled into the following
'
'****
'
'****
' declare some array storage for names and paths
'****
'
Dim grouppaths(500) As String
Dim groupnames(500) As String
numheader2 = 4
Dim headers2(4) As String
headers2(1) = "GroupName"
headers2(2) = "DeviceName"
headers2(3) = "OperatingSystem"
headers2(4) = "DistinguishedName"
NoEntry = "No Entry"
Const xlAscending = 1
Const xlDescending = 2
Const xlYes = 1
Const TallyName = "Counts"
Const ListName = "Devices"
'
'****
' prompt user for group to find
'****
'
groupname = InputBox("Please enter the name of the group:")
If groupname = "" Then
Exit Sub
End If
'
'****
' set up our ADO query and excute it to find group matches
'****
'
Application.StatusBar = "Searching for Records..."
Set cmd = CreateObject("ADODB.Command")
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open "Provider=ADsDSOObject;"
cmd.CommandText = "SELECT adspath,cn from 'LDAP://" & getNC & _
"' WHERE objectCategory = 'Group' and cn = '" & groupname & "'"
cmd.activeconnection = cn
Set rs = cmd.Execute
'
'****
' process the results of the query into our arrays for later
'****
'
i = 0
While rs.EOF <> True And rs.bof <> True
grouppaths(i) = rs.Fields("adspath").Value
groupnames(i) = rs.Fields("cn").Value
rs.movenext
i = i + 1
Wend
cn.Close
If i = 0 Then
MsgBox "Nothing Found, Exiting"
Exit Sub
End If
Application.StatusBar = "Records Found..." & i
'
'****
' Turn off updates and calculations
'****
'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = True
'
'****
' found something so create the output files and write the headers
'****
'
Application.StatusBar = "Creating Worksheet headers..."
If i > 0 Then
'
'****
' Copy Field names to header row of worksheet 1
'****
'
Set objsheet = Worksheets(1)
objsheet.Cells(1, 1).Value = "GroupName"
objsheet.Cells(1, 1).Font.Bold = True
objsheet.Cells(1, 2).Value = "Count"
objsheet.Cells(1, 2).Font.Bold = True
'
'****
' Copy Field names to header row of worksheet 2
'****
'
Set objsheet = Worksheets(2)
For h = 1 To numheader2
objsheet.Cells(1, h) = headers2(h)
objsheet.Cells(1, h).Font.Bold = True
Next
End If
'
'****
' now process each group found and extract all members
'****
'
cl = 1 'count lines
gl = 1 'group lines
Application.StatusBar = "Populating Worksheets..."
For j = 0 To i - 1
Application.StatusBar = "Writing Group " & j & " of " & i
Set objgroup = GetObject(grouppaths(j))
Set objsheet = Worksheets(1)
cl = cl + 1
objsheet.Cells(cl, 1).Value = groupnames(j)
objsheet.Cells(cl, 2).Value = objgroup.Members.Count
c = objgroup.Members.Count
g = 0
Set objsheet = Worksheets(2)
If objgroup.Members.Count > 0 Then
For Each objmember In objgroup.Members
g = g + 1
Application.StatusBar = "Writing Group Details " & g & " of " & c
gl = gl + 1
objsheet.Cells(gl, 1).Value = groupnames(j)
objsheet.Cells(gl, 2).Value = Right(objmember.Name, Len(objmember.Name) - 3)
objsheet.Cells(gl, 3).Value = objmember.OperatingSystem
objsheet.Cells(gl, 4).Value = objmember.distinguishedName
Next
Else
gl = gl + 1
objsheet.Cells(gl, 1).Value = groupnames(j)
For h = 2 To numheader2
objsheet.Cells(gl, h) = NoEntry
Next
End If
Next
'
'****
' All done, name sheet, sort data, autofit columns, close up and exit
'****
'
'
'****
' to sort the data we have to actually select the required sheet before we can do anything
'****
'
Application.StatusBar = "Sorting Worksheets..."
Set objworksheet = Worksheets(1)
objworksheet.Name = TallyName
objworksheet.Select
Set objRange = objworksheet.UsedRange
Set objRange2 = Range("A1")
objRange.Sort objRange2, xlAscending, , , , , , xlYes
ActiveSheet.UsedRange.Columns.EntireColumn.AutoFit
Set objworksheet = Worksheets(2)
objworksheet.Name = ListName
objworksheet.Select
Set objRange = objworksheet.UsedRange
Set objRange2 = Range("A1")
Set objRange3 = Range("B1")
objRange.Sort objRange2, xlAscending, objRange3, , xlAscending, , , xlYes
ActiveSheet.UsedRange.Columns.EntireColumn.AutoFit
'
'****
' Turn ON updates and calculations
'****
'
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = False
MsgBox "All Done"
End Sub
Function getNC()
Set objRoot = GetObject("ldap://RootDSE")
getNC = objRoot.get("defaultNamingContext")
End Function
