Как я могу получить список всех членов группы, используя VBA?

Question

Я нашел какой-то код в интернете и возился с ним, чтобы вывести список всех членов группы в Active Directory.

мой окончательный результат должен быть примерно таким:

* 1005 Е.Г. *

Group 1, User 1
Group 1, User 2
Group 2, User 1
Group 3, User 3

Etc

Function GetGroupUsers(ByVal strGroupName As String) As String

    Dim objGroup, objDomain, objMember
    Dim strMemberlist As String, strDomain As String
    Set objDomain = GetObject("LDAP://rootDse")
    strDomain = objDomain.Get("dnsHostName")

    Debug.Print strGroupName
    Debug.Print strDomain

    Set objGroup = GetObject("WinNT://" & strDomain & "/" & strGroupName & ",group")
    Debug.Print objGroup

    Dim i
    i = 0

    For Each objMember In objGroup.Members
        strMemberlist = strMemberlist & "," & objMember.Name
        Debug.Print strMemberlist
        i = i + 1
        Debug.Print i
    Next objMember
    ' strip off the leading comma
    GetGroupUsers = Mid$(strMemberlist, 2)

End Function

Answer 1

У каждого участника может быть пара групп

, попробуйте посмотреть вокруг этого

Sub testLookup()
    PrintMemberOf Environ("USERNAME")
End Sub

Public Sub PrintMemberOf(samAccountName As String)
    Dim sDomain     As String
    Dim groups      As Variant
    Dim x           As Long
    'Get the Domain from the Current logged on user
    Set dd = CreateObject("ADSystemInfo")
    With CreateObject("ADSystemInfo")
        sDomain = .DomainShortName
    End With
    'Assign the groups to an array
    groups = GetMembers(GetDN(samAccountName, sDomain))
        'Print each group
        For x = LBound(groups) To UBound(groups)
            Debug.Print groups(x)
        Next x
End Sub

Public Function GetMembers(strDN As String) As Variant
'Function to return the memberof property
    With GetObject("LDAP://" & strDN)
        GetMembers = .memberOf
    End With
End Function

Function GetDN(ByVal samAccountName, ByVal sDomain)
'Function to return the DN from a given samAccountName and Domain
    With CreateObject("NameTranslate")
        .Init 1, sDomain
        .Set 3, sDomain & "\" & samAccountName
        GetDN = .Get(1)
    End With
End Function



Function getADAll()
    UserName = Environ("USERNAME")

    Set RootDSE = GetObject("LDAP://RootDSE")
    Base = "<LDAP://" & RootDSE.Get("defaultNamingContext") & ">"
    'filter on user objects with the given account name
    '"samAccountName,givenName,sn,displayName,mail,userPrincipalName,l,c,mobile,facsimileTelephoneNumber,info,title,department,company,manager"
    attr = "samAccountName,givenName,sn,displayName,mail,userPrincipalName,l,c,mobile,facsimileTelephoneNumber,info,title,department,company,manager"
    fltr = "(&(objectClass=*)(objectCategory=Person))"

            '"(sAMAccountName=" & UserName & "))"

    scope = "subtree"

    Set conn = CreateObject("ADODB.Connection")
    conn.Provider = "ADsDSOObject"
    conn.Open "Active Directory Provider"

    Set cmd = CreateObject("ADODB.Command")
    Set cmd.activeconnection = conn
    cmd.CommandText = Base & ";" & fltr & ";" & attr & ";" & scope

    Set rs = cmd.Execute
    strArr = Split(attr, ",")
    ThisWorkbook.Worksheets("Data").[A1].Resize(1, UBound(strArr)) = strArr
    y = 2
    Do Until rs.EOF

        For i = 0 To rs.Fields.Count - 1
            ThisWorkbook.Worksheets("Data").Cells(y, i + 1).Value = rs.Fields(i).Value
        Next i
        y = y + 1
      rs.movenext
    Loop
    rs.Close

    conn.Close
End Function