Is it possible for Access to directly check a user's membership status
in an Active Directory user group?
Here's the situation... I would like to use Active Directory groups to
control access to some access databases I have been assigned. These
are mdb's, not adp's. (I know, I know.... )
The mdb's currently use workgroup security, which means that the
passwords are not synched with the user's network password. I would
like to upgrade them to use AD groups for permission control.
If these were adp's then I could just use IS_MEMBER ({'<group>' |
'<role>'}). Since they are not, that won't work directly. I know that
I could set up a query calling a stored procedure on the SQL server,
returning the results of the IS_MEMBER check.
I would rather, however, have Access do this DIRECTLY... not having to
go to the SQL server for help. Does someone know how I could do this
from VBA code or some other way?
Thanks!
Didn't get an answer in this group, but I did get some help in the
ADSI group. In case someone needs this in the future, here is the
code I developed to resolve this. My thanks to Josh, the author of
http://www.apostate.com/programming/wsh-adsi.html#Displaying Groups,
which provided a windows script starting point for these functions.
---------------------------
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Option Compare Database
Option Explicit
'---------------------------------------------------------------------------------------
' Procedure : getusergroups
' Created : 2/8/2007 10:42
' Author : Scott Hall
' Purpose : Lists the user's groups
' Inputs : User ID and AD Domain
' Outputs : Prints user's groups to the immediate window
'---------------------------------------------------------------------------------------
'
Function getusergroups(strUserID As String, strDomain As String)
Dim UserObj As Object
Dim GroupObj As Object
Dim strPath As String
On Error GoTo getusergroups_Error
strPath = "WinNT://" & strDomain & "/" & strUserID
Set UserObj = GetObject(strPath)
'Set UserObj = GetObject("WinNT://FT/wsh00op")
For Each GroupObj In UserObj.Groups
Debug.Print GroupObj.Name
Next
Set UserObj = Nothing
Set GroupObj = Nothing
On Error GoTo 0
Exit Function
getusergroups_Error:
MsgBox "Error: We're sorry... there was an error. Please report
the following to programmer: Procedure getusergroups in the Module
Module1 threw error " & Err.Number & " (" & Err.Description & ")"
End Function
'---------------------------------------------------------------------------------------
' Procedure : getdomains
' Created : 2/8/2007 10:45
' Author : Scott Hall
' Purpose : Gets the user's domains and prints them to the immediate
window
' Inputs : None
' Outputs :
'---------------------------------------------------------------------------------------
'
Function getdomains()
Dim NameSpaceObj
Dim DomObj
On Error GoTo getdomains_Error
Set NameSpaceObj = GetObject("WinNT:")
NameSpaceObj.Filter = Array("domain")
For Each DomObj In NameSpaceObj
Debug.Print "Domain: " & DomObj.Name & " Class: " &
DomObj.Class
Next
On Error GoTo 0
Exit Function
getdomains_Error:
MsgBox "Error: We're sorry... there was an error. Please report
the following to programmer: Procedure getdomains in the Module
Module1 threw error " & Err.Number & " (" & Err.Description & ")"
End Function
'---------------------------------------------------------------------------------------
' Procedure : fOSUserName
' Created : 2/8/2007 10:46
' Purpose : Gets the user's network login name
' Inputs : None
' Outputs : network login name as string
' Notes : Requires the following in the module declartions...
' Private Declare Function apiGetUserName Lib
"advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize
As Long) As Long
' This function was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
'---------------------------------------------------------------------------------------
'
Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
On Error GoTo fOSUserName_Error
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
On Error GoTo 0
Exit Function
fOSUserName_Error:
MsgBox "Error: We're sorry... there was an error. Please report
the following to programmer: Procedure fOSUserName in the Module
Module1 threw error " & Err.Number & " (" & Err.Description & ")"
End Function
'******************** Code End **************************
'---------------------------------------------------------------------------------------
' Procedure : fctCheckGroupMembership
' Created : 2/8/2007 10:50
' Author : Scott Hall
' Purpose : Checks if a user is a member of an Active Directory
group
' Inputs : User ID, AD Domain, Group Name
' Outputs : True/False
' Example : debug.Print fctCheckGroupMembership("MyUserName",
"MyDomain", "MyUserGroup")
'---------------------------------------------------------------------------------------
'
Function fctCheckGroupMembership(strUserID As String, strDomain As
String, strGroupName As String)
Dim UserObj As Object
Dim GroupObj As Object
Dim strPath As String
On Error GoTo fctCheckGroupMembership_Error
fctCheckGroupMembership = False
strPath = "WinNT://" & strDomain & "/" & strUserID
Set UserObj = GetObject(strPath)
'Set UserObj = GetObject("WinNT://FT/wsh00op")
For Each GroupObj In UserObj.Groups
'Debug.Print GroupObj.Name
If (GroupObj.Name = strGroupName) Then
'Debug.Print "Match"
fctCheckGroupMembership = True
End If
Next
Set UserObj = Nothing
Set GroupObj = Nothing
On Error GoTo 0
Exit Function
fctCheckGroupMembership_Error:
MsgBox "Error: We're sorry... there was an error. Please report
the following to programmer: Procedure fctCheckGroupMembership in the
Module Module1 threw error " & Err.Number & " (" & Err.Description &
")"
End Function
