Printing Access security information

[BSman]

We have auditors coming in to review an Access application that uses the Access workgroup security. It is anticipated that they will want a list of users, groups, and the rights within each group/user. There is a printout available on the Tools/Security menu of the users and groups, but I can't figure out how to print out a list of the object rights for each group and/or user. I know that this could kill a few trees because of the number of objects, etc., but I'd like to know if there is a way to print this data out (ideally for a selected group or user, rather than all or nothing).

 

[LittleSmudge]

I ended up writing my own utility to do what you're asking because I couldn't find a way.


Create a new form and add two text box controls
The first called txtResultT and the other call txtResultQ

Then add a Command button called cmdInvestigate

Then add the following code

Private Sub cmdInvestigate_Click()
Dim rst As ADODB.Recordset
Dim cat As ADOX.Catalog
Dim grps As Groups
Dim grp As Group
Dim tbl As Table
Dim lngRetValue As Long
'Dim grpthing As Groups
Set rst = New ADODB.Recordset
rst.CursorType = adOpenKeyset
rst.LockType = adLockOptimistic
rst.ActiveConnection = CurrentProject.Connection

Set cat = New ADOX.Catalog
Set cat.ActiveConnection = CurrentProject.Connection
' rst.Open "SELECT Name, Type FROM MSysObjects " _
         & "WHERE Type = X "      ' Look at Tables, Queries
' Type = 6 > Linked Access Tables
' Type = 5 AND Flags = 112 > PT Query
' Type = 5 AND Flags = 0 > table Query
' Type = 4 > OBDC linked table
' Type = 1 AND Flags = 0 > Table in db

' Type = -32768 > Form
' Type = -32764 > Report

txtResultT = ""
For Each grp In cat.Groups
    rst.Open "SELECT Name, Type FROM MSysObjects " _
           & "WHERE Type = 4 OR (Type = 1 AND Flags = 0) OR Type = 6 "
    While Not rst.EOF
            lngRetValue = grp.GetPermissions(rst!Name, adPermObjTable)
            If lngRetValue = 0 Or lngRetValue = ((2 ^ 17) + (2 ^ 14)) Then
            Else
                txtResultT = txtResultT & grp.Name & " :  " _
                           & rst!Name & " :   " _
                           & Interpret(lngRetValue) & "  :   " _
                           & lngRetValue & vbCrLf
            End If
        rst.MoveNext
    Wend
    rst.Close
Next

txtResultQ = ""
For Each grp In cat.Groups
    rst.Open "SELECT Name, Type FROM MSysObjects " _
           & "WHERE Type = 5 AND (Flags = 112 OR Flags = 0) "
    While Not rst.EOF
        lngRetValue = grp.GetPermissions(rst!Name, adPermObjTable)
        If lngRetValue = 0 Or lngRetValue = ((2 ^ 17) + (2 ^ 14)) Then
        Else
            txtResultQ = txtResultQ & grp.Name & " :  " _
                       & rst!Name & " :   " _
                       & Interpret(lngRetValue) & "  :   " _
                       & lngRetValue & vbCrLf
        End If
        rst.MoveNext
    Wend
    rst.Close
Next

End Sub

Private Function Interpret(lngValue As Long) As String

Const conDeR = 2 ^ 10
Const conDeM1 = 2 ^ 11
Const conDeM2 = 2 ^ 8
Const conDeA1 = 2 ^ 19
Const conDeA2 = 2 ^ 18
Const conDaR = -2147483648#   ' 2^31 ( But 2^31 does not work in this contect )
Const conDaU = 2 ^ 30
Const conDaI = 2 ^ 15
Const conDaD = 2 ^ 16

Dim strTempResult
strTempResult = "Design = "
If lngValue And conDeR Then
    strTempResult = strTempResult & "R,"
Else
    strTempResult = strTempResult & ".,"
End If
If (lngValue And conDeM1) Or (lngValue And conDeM2) Then
    strTempResult = strTempResult & "M,"
Else
    strTempResult = strTempResult & ".,"
End If
If (lngValue And conDeA1) Or (lngValue And conDeA2) Then
    strTempResult = strTempResult & "A,"
Else
    strTempResult = strTempResult & ".,"
End If

strTempResult = strTempResult & " :   Data = "
If lngValue And conDaR Then
    strTempResult = strTempResult & "R,"
Else
    strTempResult = strTempResult & ".,"
End If
If lngValue And conDaU Then
    strTempResult = strTempResult & "U,"
Else
    strTempResult = strTempResult & ".,"
End If
If lngValue And conDaI Then
    strTempResult = strTempResult & "I,"
Else
    strTempResult = strTempResult & ".,"
End If
If lngValue And conDaD Then
    strTempResult = strTempResult & "D,"
Else
    strTempResult = strTempResult & ".,"
End If
Interpret = strTempResult

End Function

Click the command button and stand well back.

All you then have to do is select the text that appears in each box and Copy & Paste into a word doc or similar.



'ope-that-'elps.



G LS
spsinkNOJUNK@yahoo.co.uk
Remove the NOJUNK to use.

 

[BSman]

Thanks. Sounds like what I might need.

Unfortunately, the application is in Access 97 (and won't convert to Access 2000 without a lot of rewriting) and your code seems to need Access 2000 references. Can your code be easily modified to run in Access 2000?

 

[PHV]

Add the following references to your VBA module:
Microsoft ActiveX Data Objects 2.x Library
Microsoft ADO Ext 2.x for DDL and Security

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244