1

渡した特定のグループにユーザーがいる場合にtrueを返すコードがありますが、渡したグループの一部である別のグループにユーザーがいる場合、関数はfalseを返します。ユーザーが関心のあるグループに含まれるグループのメンバーである可能性があるかどうかを確認するために、グループを反復処理できる必要があります。

たとえば、ユーザーがGroupAに属し、Group_AのすべてのメンバーがGroup_Bに属している場合、ユーザーがGroup_Bに属しているかどうか、つまりGroup_Aに属しているかどうかを知る必要があります。これが私が今持っているものです：**** EDITはIsUserInRole（）で使用される関数GetCurrentUserを追加しました

Public Function GetCurrentUser() As String
    GetCurrentUser = Environ("USERNAME")
End Function

Public Function IsUserInRole(role) As Boolean
Dim UserObj As Object
Dim GroupObj As Object

Dim strObjectString As String
strObjectString = "WinNT://my domain/" & GetCurrentUser() & ""
Set UserObj = GetObject(strObjectString)

For Each GroupObj In UserObj.Groups

Debug.Print GroupObj.Name

   If GroupObj.Name = role Then
        IsUserInRole = True
        Exit Function
   End If
Next

終了機能

4

1 に答える 1

2

わかりました、私はMSを通してこれに対する解決策を得ました。モジュール内にある関数にグループ名を渡すアクセスフォームにいくつかのコードがあります。この関数は、ユーザーがメンバーであるすべてのグループを反復処理し、渡されたグループ内の任意のグループを反復処理します。ユーザーがグループのメンバーであるか、渡されたメンバーであるグループのメンバーである場合、trueを返します。グループで。

フォーム上のコード：

strGroup = "_System Admin"
If IsCurrentUserInGroup(strGroup) = True Then
    MsgBox "In System Admin"
End If

モジュールの上部で宣言されたパブリック変数：

Public strOut As String
Public objGroupList, objUser

IsCurrentUserInGroupコード：

Function IsCurrentUserInGroup(ByVal strGroup) As Boolean

Dim objSysInfo As Object
Dim strDN As String

'Get currentlly logged in users info
Set objSysInfo = CreateObject("ADSystemInfo")
strDN = objSysInfo.UserName

On Error Resume Next
Set objUser = GetObject("LDAP://" & strDN)
If (Err.Number <> 0) Then
   On Error GoTo 0
   MsgBox "User not found" & vbCrLf & strDN

End If
On Error GoTo 0

' Bind to dictionary object.
Set objGroupList = CreateObject("Scripting.Dictionary")

' Enumerate group memberships.
If EnumGroups(objUser, "", strGroup) = True Then
    IsCurrentUserInGroup = True
Else
    IsCurrentUserInGroup = False
End If

End Function

EnumGroupsコード：

Public Function EnumGroups(ByVal objADObject, ByVal strOffset, ByVal strGroup) As Boolean
' Recursive subroutine to enumerate user group memberships.
' Includes nested group memberships.
Dim colstrGroups, objGroup, j
objGroupList.CompareMode = vbTextCompare
colstrGroups = objADObject.memberOf
If (IsEmpty(colstrGroups) = True) Then
    Exit Function
End If
If (TypeName(colstrGroups) = "String") Then
    ' Escape any forward slash characters, "/", with the backslash
    ' escape character. All other characters that should be escaped are.
    colstrGroups = Replace(colstrGroups, "/", "\/")
    Set objGroup = GetObject("LDAP://" & colstrGroups)
    If (objGroupList.Exists(objGroup.sAMAccountName) = False) Then
        objGroupList.Add objGroup.sAMAccountName, True
         strOut = strOut + strOffset & objGroup.distinguishedName + Chr(13) + Chr(10)
        Call EnumGroups(objGroup, strOffset & "--", "")
    Else
        strOut = strOut + strOffset + strOffset & objGroup.distinguishedName & " (Duplicate)" + Chr(13) + Chr(10)
    End If
    Exit Function
End If
For j = 0 To UBound(colstrGroups)
    ' Escape any forward slash characters, "/", with the backslash
    ' escape character. All other characters that should be escaped are.
    colstrGroups(j) = Replace(colstrGroups(j), "/", "\/")
    Set objGroup = GetObject("LDAP://" & colstrGroups(j))
    If (objGroupList.Exists(objGroup.sAMAccountName) = False) Then
        If objGroup.sAMAccountName = strGroup Then
            EnumGroups = True                 
        End If
        objGroupList.Add objGroup.sAMAccountName, True
        strOut = strOut + strOffset & objGroup.distinguishedName + Chr(13) + Chr(10)
        Call EnumGroups(objGroup, strOffset & "--", "")
    Else
        strOut = strOut + strOffset & objGroup.distinguishedName & " (Duplicate)" + Chr(13) + Chr(10)
    End If
Next
End Function
于 2012-08-17T18:21:28.970 に答える