Public Function BelongsToGroup(strUserName As String, strGroupName As String) As Boolean
' This function will return TRUE IF the current user is a member of the group supplied in the arguments _
Dim conn As New ADODB.Connection
Dim cat As New ADOX.Catalog
Dim i, k As Integer
Dim ConnStr As String
On Error GoTo Error
BelongsToGroup = False
MdwLocation = "Jet OLEDB:System database=" & SysCmd(acSysCmdGetWorkgroupFile)
ConnStr = "data source=" & CurrentDb.name & ";" & MdwLocation & ";user id=db_admin;Password='YOURdb_adminPASSWORD'"
With conn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = ConnStr
.Open
End With
Set cat.ActiveConnection = conn
With cat
For i = 0 To (.Users(strUserName).Groups.Count - 1) ' Check all groups of this username
Debug.Print "gebruiker: " & strUserName & " behoort tot de groep: " & .Users(strUserName).Groups(i)
If .Users(strUserName).Groups(i) = strGroupName Then
BelongsToGroup = True
End If
Next i
End With
conn.Close
Exit Function
Error:
If Err.Number = 3265 Then
Debug.Print "user: " & strUserName & " is not a user of this db."
Exit Function
Else
DoCmd.SetWarnings True
MsgBox Err.Description & " " & Err.Number
End If
conn.Close
End Function