Блог

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

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

Например.

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

И т. Д

 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://" amp; strDomain amp; "/" amp; strGroupName amp; ",group")
    Debug.Print objGroup

    Dim i
    i = 0

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

End Function
 

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

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

 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://" amp; 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 amp; "" amp; samAccountName
        GetDN = .Get(1)
    End With
End Function



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

    Set RootDSE = GetObject("LDAP://RootDSE")
    Base = "<LDAP://" amp; RootDSE.Get("defaultNamingContext") amp; ">"
    '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 = "(amp;(objectClass=*)(objectCategory=Person))"

            '"(sAMAccountName=" amp; UserName amp; "))"

    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 amp; ";" amp; fltr amp; ";" amp; attr amp; ";" amp; 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