Excel VB: effektive AD-Gruppen Mitglieder auflisten

Hallo Admins,

ich habe ein Problem mit der Umsetzung. In Excel habe ich mir ein Tabellenblatt gebastelt. Es soll mir die Gruppenmitglieder einer AD-Gruppe auflisten.
Der Code funktioniert schon soweit gut. Es werden aber nur die Members der Gruppe aufgelistet aber nicht die effektiven Rechte.

Nehmen wir an, es gibt eine Gruppe "Mitarbeiter". Diese beinhaltet einzelne Namen und auch Gruppen. Mit einem Power-Shell-Befehl kann ich mir rekursiv die Namen ausgeben, die in der Gruppe nebst Verschachtelung gelistet sind.

Hier der Befehl:

Get-ADGroupMember -identity “mitarbeiter” -recursive | select name | Export-csv -path C:\tmp\Groupmembers.csv -NoTypeInformation

In meiner Excel-Tabelle habe ich nun ein Problem dies umzusetzen.

Mein Code sieht so aus:

Dim grouppaths(500) As String
Dim groupnames(500) As String

numheader2 = 4
Dim headers2(4) As String

headers2(1) = "GroupName"  
headers2(2) = "Name"  
headers2(3) = "eMail"  

NoEntry = "No Entry"  

Const xlAscending = 1
Const xlDescending = 2
Const xlYes = 1

Const TallyName = "Counts"  
Const ListName = "Members"  


groupname = Range("A1").value  


If groupname = "" Then  
    Exit Sub
End If


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


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  


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Application.DisplayStatusBar = True


Application.StatusBar = "Creating Worksheet headers..."  

If i > 0 Then



    Set objsheet = Worksheets(2)
    For h = 1 To numheader2
        objsheet.Cells(4, h) = headers2(h)
        objsheet.Cells(4, h).Font.Bold = True
    Next
End If

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 = 1
    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.mail
            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

Application.StatusBar = "Sorting Worksheets..."  

Set objworksheet = Worksheets(2)
objworksheet.Select

Set objRange = objworksheet.UsedRange
Set objRange2 = Range("A5")  

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("A5")  
Set objRange3 = Range("B5")  

objRange.Sort objRange2, xlAscending, objRange3, , xlAscending, , , xlYes
ActiveSheet.UsedRange.Columns.EntireColumn.AutoFit

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = False

Ich muss gestehen, dass dieser Code aus dem Internet zusammengebastelt wurde und ich nicht so richtig coden kann.

Vielleicht ist die Umsetzung recht fix möglich.

Ich danke für die Tipps.

Grüße
VB

Please also mark the comments that contributed to the solution of the article

Content-Key: 2183334309

Url: https://administrator.de/contentid/2183334309

Printed on: April 27, 2024 at 07:04 o'clock

2 Comments

Latest comment

Mach halt ne rekursive Abfrage draus indem du die objectclass prüfst , bsp.

function GetGroupMembersRecursive(grp)
    Set objGroup = GetObject("LDAP://" & grp)  
    objGroup.GetInfo
    For Each memberDN in objGroup.GetEx("member")  
    	group = false
		set member = GetObject("LDAP://" & memberDN)  
		for each val in member.GetEx("objectclass")  
			if val = "group" then   
                             group = true
			     exit for
                        end if
		Next
		if group then
			GetGroupMembersRecursive member.DistinguishedName
		else
			Msgbox member.name
		End if
	Next
End Function
GetGroupMembersRecursive "cn=Testgruppe,ou=Marketing,dc=mydomain,dc=tld"  

Hallo Pretty,

danke für die Funktion. ich starte den Aufruf mit GetGroupMembersRecursive... (deine Zeile 20) und ändere das ab:

groupname = Range("A1").value  
GetGroupMembersRecursive "cn=" & groupname & ",ou=it ,dc=meine.org"  

und erhalten dann in "member.name" den Usernamen zurück, den ich dann weiter unten benötige. Ich hoffe, dass ich soweit richtig bin.

Frage: ersetze ich mit deiner Funktion alles ab Zeile 30 bis 53 (aus meiner Listing oben) ?

und ändere dann unten die Variable groupnames(j) in member.name(j) beginnend ab Zeile 87?

sorry, dass ich noch etwas unbeholfen bin.

Danke aber für die Antwort.

German Question Development