Current User is found by using the CurrentUser method:
debug.print "The current user is: " & CurrentUser
Users can belong to more than one group - here's a function (albeit not very
useful except for display purposes) that gets a list of all the groups to
which a particular user belongs:
Public Function UserGroups(strUser As String)
Dim ws As dao.Workspace
Dim strUserName As String
Dim strUserGroups As String
Dim usr As dao.User
Dim inti As Integer
Dim grp As dao.Group
Set ws = DBEngine.Workspaces(0)
For Each grp In ws.Groups
For inti = 0 To grp.Users.count - 1
If grp.Users(inti).Name = strUser Then
strUserGroups = strUserGroups & grp.Name & ", "
End If
Next inti
Next grp
UserGroups = Left(strUserGroups, Len(strUserGroups) - 2)
Set grp = Nothing
Set ws = Nothing
End Function
More often, we want to know whether a user is in a particular group. A
UserInGroup function will give this information. The UserInGroup function
can be done a couple of ways the first involves 2 functions - one to ensure
that the group exists, then if it does exist, the second to determine
whether the user is in the group. This method is a bit more reliable than
the second I'll show later:
Public Function UserInGroup(strUser As String, _
strGroup As String) As Boolean
Dim ws As dao.Workspace
Dim strUserName As String
Dim usr As dao.User
Dim inti As Integer
Dim fUserInGroup As Boolean
Set ws = DBEngine.Workspaces(0)
If GroupExists(strGroup) Then
For inti = 0 To ws.Groups(strGroup).Users.count - 1
If ws.Groups(strGroup).Users(inti).Name = strUser Then
fIsUserInGroup = True
End If
Next inti
End If
UserInGroup = fUserInGroup
set ws=nothing
End Function
Public Function GroupExists(strGroup) As Boolean
Dim ws As dao.Workspace
Dim strUserName As String
Dim usr As dao.User
Dim inti As Integer
Dim fGroupExists As Boolean
Set ws = DBEngine.Workspaces(0)
For inti = 0 To ws.Groups.count - 1
If ws.Groups(inti).Name = strGroup Then
fGroupExists = True
End If
Next inti
GroupExists = fGroupExists
set ws=nothing
End Function
Here's the one function method - note that it does not differentiate the
error that occurs if marked line fails.
Function UserInGroup(strUser As String, _
strGroup As String) As Boolean
Dim ws As Workspace
Dim strUserName As String
Set ws = DBEngine.Workspaces(0)
On Error Resume Next
' if this normally line fails then the user is not in the group
' but it could fail due to some other error condition so
' this method might be considered a bit sloppy
strUserName = ws.Groups(strGroup).Users(strUser).Name
UserInGroup = (Err = 0)
End Function
