使用VBA确定用户的组成员身份

时间:2009-01-06 15:00:15

标签: vba security ms-access access-vba

如何确定用户(例如Access)是否是Active Directory安全组的成员?

我宁愿不在我的小型Access数据库中构建一个完整的身份验证系统。

由于

3 个答案:

答案 0 :(得分:13)

Allain找到this online

Function IsMember(strDomain As String, strGroup _
  As String, strMember As String) As Boolean
  Dim grp As Object
  Dim strPath As String

  strPath = "WinNT://" & strDomain & "/"
  Set grp = GetObject(strPath & strGroup & ",group")
  IsMember = grp.IsMember(strPath & strMember)
End Function

您可以通过USERDOMAINUSERNAME环境变量获取Windows帐户信息:

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

Function GetCurrentDomain() As String
    GetCurrentDomain = Environ("USERDOMAIN")
End Function

全部放在一起:

If IsMember(GetCurrentDomain, "AD Group", GetCurrentUser) Then
   DoStuff()
End If

答案 1 :(得分:10)

我迟到了,但你需要的代码如下。它为您获取用户名和域名。

请注意,我没有使用objGroup.Ismember - 这实际上是正确使用的方法 - 我列举了用户所在的组列表,因为它更容易调试,并且没有明显的性能损失。< / p>

...我解除了早期项目中的代码,我需要检查“阅读报告”组,“编辑数据”组和“编辑系统数据”组的成员身份,以便我可以选择启用哪些控件以及以只读方式打开哪些表单。枚举组一次比三次单独检查更快。

Public Function UserIsInGroup(GroupName As String, _
                              Optional Username As String, _
                              Optional Domain As String) As Boolean
'On Error Resume Next

' Returns TRUE if the user is in the named NT Group.

' If user name is omitted, current logged-in user's login name is assumed.
' If domain is omitted, current logged-in user's domain is assumed.
' User name can be submitted in the form 'myDomain/MyName' 
'                                        (this will run slightly faster)
' Does not raise errors for unknown user.
'
' Sample Usage: UserIsInGroup( "Domain Users")

Dim strUsername As String
Dim objGroup    As Object
Dim objUser     As Object
Dim objNetwork  As Object

UserIsInGroup = False

If Username = "" Then
    Set objNetwork = CreateObject("WScript.Network")
    strUsername = objNetwork.UserDomain & "/" & objNetwork.Username
Else
    strUsername = Username
End If

strUsername = Replace(strUsername, "\", "/")
If InStr(strUsername, "/") Then
    ' No action: Domain has already been supplied in the user name
Else    
    If Domain = "" Then
        Set objNetwork = CreateObject("WScript.Network")
        Domain = objNetwork.UserDomain
    End If        
    strUsername = Domain & "/" & strUsername        
End If

Set objUser = GetObject("WinNT://" & strUsername & ",user")    
If objUser Is Nothing Then    
    ' Insert error-handler here if you want to report an unknown user name
Else
    For Each objGroup In objUser.Groups
        'Debug.Print objGroup.Name
        If GroupName = objGroup.Name Then
            UserIsInGroup = True
            Exit For
        End If
    Next objGroup
End If

Set objNetwork = Nothing
Set objGroup = Nothing
Set objUser = Nothing

End Function

希望这个迟到的提交对其他开发人员有用:当我第一次看到它时,早在2003年,就像没有人在Excel或MS-Access中使用AD组一样。

答案 2 :(得分:2)

找到this online

Function IsMember(strDomain As String, strGroup _
  As String, strMember As String) As Boolean
  Dim grp As Object
  Dim strPath As String

  strPath = "WinNT://" & strDomain & "/"
  Set grp = GetObject(strPath & strGroup & ",group")
  IsMember = grp.IsMember(strPath & strMember)
End Function

现在,我只需要当前用户的帐户名称。太糟糕了Application.CurrentUser没有给我他们的域帐户名。