Results 1 to 4 of 4
  1. #1
    Super Moderator WebGenii's Avatar
    Join Date
    Jan 2001
    Location
    Redcliff, Alberta, Canada
    Posts
    4,066
    Thanks
    2
    Thanked 5 Times in 5 Posts

    CurrentUser/CurrentGroup (Access 2002/SP3)

    I'm looking for a function to determine the group membership of the CurrentUser. Any suggestions?
    [b]Catharine Richardson (WebGenii)
    WebGenii Home Page
    Moderator: Spreadsheets, Other MS Apps, Presentation Apps, Visual Basic for Apps, Windows Mobile

  2. #2
    Bronze Lounger
    Join Date
    Nov 2001
    Location
    Arlington, Virginia, USA
    Posts
    1,394
    Thanks
    0
    Thanked 3 Times in 3 Posts

    Re: CurrentUser/CurrentGroup (Access 2002/SP3)

    Here is simple function that will return specified User's Group membership as a delimited text string; some other output format can be used by modifying code. Example:

    <code>Public Function GetUserGroups(strUserName As String) As String</code>
    <code> On Error GoTo Err_Handler</code>
    <code></code>
    <code> Dim ws As DAO.Workspace</code>
    <code> Dim usr As DAO.User</code>
    <code> Dim grp As DAO.Group</code>
    <code> Dim n As Long</code>
    <code> Dim s As String</code>
    <code> Dim strMsg As String</code>
    <code> </code>
    <code> Set ws = DBEngine.Workspaces(0)</code>
    <code> Set usr = ws.Users(strUserName)</code>
    <code> </code>
    <code> For Each grp In usr.Groups</code>
    <code> s = s & grp.Name & ";"</code>
    <code> Next grp</code>
    <code> </code>
    <code> GetUserGroups = Left$(s, Len(s) - 1)</code>
    <code> </code>
    <code>Exit_Function:</code>
    <code> Set ws = Nothing</code>
    <code> Set grp = Nothing</code>
    <code> Set usr = Nothing</code>
    <code> Exit Function</code>
    <code>Err_Handler:</code>
    <code> strMsg = "Error No " & Err.Number & ": " & Err.Description</code>
    <code> Beep</code>
    <code> MsgBox strMsg, vbExclamation, "GET GROUP FUNCTION ERROR"</code>
    <code> Resume Exit_Function</code>
    <code> </code>
    <code>End Function</code>

    Example:

    ? GetUserGroups(CurrentUser())
    Admins;Supervisors;Users

    To return an array with Group names:

    <code>Sub TestGetUserGroups(strUserName As String)</code>
    <code></code>
    <code> Dim Grp() As String</code>
    <code> Dim s As String</code>
    <code> Dim n As Long</code>
    <code> </code>
    <code> s = GetUserGroups(strUserName)</code>
    <code> Grp = Split(s, ";", , vbBinaryCompare)</code>
    <code> </code>
    <code> For n = 0 To UBound(Grp)</code>
    <code> Debug.Print Grp(n)</code>
    <code> Next n</code>
    <code></code>
    <code>End Sub</code>

    Test Results:

    TestGetUserGroups(CurrentUser())
    Admins
    Supervisors
    Users

    Note: Requires reference set to DAO 3.6 library. ADOX can be used in similar fashion if desired, would also require external reference to be set.

    HTH

  3. #3
    Bronze Lounger
    Join Date
    Nov 2001
    Location
    Arlington, Virginia, USA
    Posts
    1,394
    Thanks
    0
    Thanked 3 Times in 3 Posts

    Re: CurrentUser/CurrentGroup (Access 2002/SP3)

    For the record, ADOX version of same function:

    <code>Public Function GetUserGroupADO(strUserName As String) As String</code>
    <code> On Error GoTo Err_Handler</code>
    <code> </code>
    <code> Dim cat As ADOX.Catalog</code>
    <code> Dim usr As ADOX.User</code>
    <code> Dim grp As ADOX.Group</code>
    <code> Dim s As String</code>
    <code> Dim strMsg As String</code>
    <code> </code>
    <code> Set cat = New ADOX.Catalog</code>
    <code> cat.ActiveConnection = CurrentProject.Connection</code>
    <code> </code>
    <code> Set usr = cat.Users(strUserName)</code>
    <code> </code>
    <code> For Each grp In usr.Groups</code>
    <code> s = s & grp.Name & ";"</code>
    <code> Next grp</code>
    <code> </code>
    <code> GetUserGroupADO = Left$(s, Len(s) - 1)</code>

    <code>Exit_Function:</code>
    <code> Set cat = Nothing</code>
    <code> Set grp = Nothing</code>
    <code> Set usr = Nothing</code>
    <code> Exit Function</code>
    <code>Err_Handler:</code>
    <code> strMsg = "Error No " & Err.Number & ": " & Err.Description</code>
    <code> Beep</code>
    <code> MsgBox strMsg, vbExclamation, "ADOX GET GROUP FUNCTION ERROR"</code>
    <code> Resume Exit_Function</code>
    <code> </code>
    <code>End Function</code>

    Note almost same as DAO code, except use Catalog object with current connection, rather than Workspace. Requires reference set to ADOX library ("Microsoft ADO Ext. 2.X for DDL and Security"), typical path (Office 2K, WIN 2K): C:Program FilesCommon FilesSystemADOmsadox.dll.

    HTH

  4. #4
    Super Moderator WebGenii's Avatar
    Join Date
    Jan 2001
    Location
    Redcliff, Alberta, Canada
    Posts
    4,066
    Thanks
    2
    Thanked 5 Times in 5 Posts

    Re: CurrentUser/CurrentGroup (Access 2002/SP3)

    Thanks
    [b]Catharine Richardson (WebGenii)
    WebGenii Home Page
    Moderator: Spreadsheets, Other MS Apps, Presentation Apps, Visual Basic for Apps, Windows Mobile

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •