Excel VB: effektive AD-Gruppen Mitglieder auflisten

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

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