Showing All Permissions for All Objects for All Users and Groups

This example iterates through each Users and Groups collection. Within those collections it iterates through all the Containers and Documents collections in the

current database and displays the permissions. This approach is useful if you want to see permissions for all the objects in the database, not just the default table and query objects that Microsoft Jet recognizes. For example, this code could be used on a database created with Microsoft Access to show permissions on not only the Microsoft Jet objects, but also the application-specific Microsoft Access objects such as forms, reports, macros, and modules.

In this example, strDbPath is the path to the database. Note that if there are many objects in the database, this procedure may take a while to run.

Sub ShowPermissions(strDbPath As String)
	Dim wrk As Workspace, dbs As Database
	Dim usr As User, grp As Group
	Dim ctr As Container, doc As Document
  
	Set wrk = DBEngine.Workspaces(0)
	Set dbs = OpenDatabase(strDbPath)
  
	For Each usr In wrk.Users
		Debug.Print "User: " & usr.Name
		Debug.Print "----------------------"
		For Each ctr In dbs.Containers
			Debug.Print "  container: " & ctr.Name
			For Each doc In ctr.Documents
				doc.UserName = usr.Name
				Debug.Print "    Document: " & doc.Name & _
					" Permissions: " & doc.Permissions
			Next doc
		Next ctr
	Next usr
  
	For Each grp In wrk.Groups
		Debug.Print "Group: " & grp.Name
		Debug.Print "----------------------"
		For Each ctr In dbs.Containers
			Debug.Print "  container: " & ctr.Name
			For Each doc In ctr.Documents
				doc.UserName = grp.Name
				Debug.Print "    Document: " & doc.Name & _
					" Permissions: " & doc.Permissions
			Next doc
		Next ctr
	Next grp
End Sub

A Better Solution

The main problem with the ShowPermissions code is that it returns only a numeric permission value for each object. The following three procedures produce a much more readable output.

First, the ShowPermissions procedure is modified to call a function to decode the value of an object’s Permissions property:

Sub ShowPermissionsAsText(strDbPath As String)
	Dim wrk As Workspace, dbs As Database
	Dim usr As User, grp As Group
	Dim ctr As Container, doc As Document
	Dim intType As Integer
  
	Set wrk = DBEngine.Workspaces(0)
	Set dbs = OpenDatabase(strDbPath)
	
	For Each usr In wrk.Users
		Debug.Print "User: " & usr.Name
		Debug.Print "----------------------"
		For Each ctr In dbs.Containers
			Debug.Print "  Container: " & ctr.Name
			Select Case ctr.Name
				Case "Tables": intType = 1
				Case "Databases": intType = 2
				Case Else: intType = -1
			End Select
			For Each doc In ctr.Documents
				doc.UserName = usr.Name
				Debug.Print "    Document: " & doc.Name
				Debug.Print "      Permissions: " & _
					DecodePerms(intType, doc.Permissions)
			Next doc
		Next ctr
	Next usr
	
	For Each grp In wrk.Groups
		Debug.Print "Group: " & grp.Name
		Debug.Print "----------------------"
		For Each ctr In dbs.Containers
			Debug.Print "  Container: " & ctr.Name
			Select Case ctr.Name
				Case "Tables": intType = 1
				Case "Databases": intType = 2
				Case Else: intType = -1
			End Select
			For Each doc In ctr.Documents
				doc.UserName = grp.Name
				Debug.Print "    Document: " & doc.Name
				Debug.Print "      Permissions: " & _
					DecodePerms(intType, doc.Permissions)
			Next doc
		Next ctr
	Next grp
End Sub

Next, two new procedures are added to perform the actual conversion:

Function DecodePerms(intType As Integer, lngPerms As Long) As String
	Dim strPerms As String
  
	' Decode the common permissions.
	If (lngPerms And dbSecNoAccess) = dbSecNoAccess Then _
		strPerms = AddString(strPerms, "dbSecNoAccess")
	
	If (lngPerms And dbSecFullAccess) = dbSecFullAccess Then _
		strPerms = AddString(strPerms, "dbSecFullAccess")
  
	If (lngPerms And dbSecDelete) = dbSecDelete Then _
		strPerms = AddString(strPerms, "dbSecDelete")
	
	If (lngPerms And dbSecReadSec) = dbSecReadSec Then _
		strPerms = AddString(strPerms, "dbSecReadSec")
  
	If (lngPerms And dbSecWriteSec) = dbSecWriteSec Then _
		strPerms = AddString(strPerms, "dbSecWriteSec")
  
	If (lngPerms And dbSecWriteOwner) = dbSecWriteOwner Then _
		strPerms = AddString(strPerms, "dbSecWriteOwner")

	' Decode specific permissions.
	Select Case intType
		Case 1
			' Object is table or query.
			If (lngPerms And dbSecReadDef) = dbSecReadDef Then _
				strPerms = AddString(strPerms, "dbSecReadDef")
	
			If (lngPerms And dbSecWriteDef) = dbSecWriteDef Then _
				strPerms = AddString(strPerms, "dbSecWriteDef")
	
			If (lngPerms And dbSecRetrieveData) = dbSecRetrieveData Then _
				strPerms = AddString(strPerms, "dbSecRetrieveData")
	
			If (lngPerms And dbSecInsertData) = dbSecInsertData Then _
				strPerms = AddString(strPerms, "dbSecInsertData")
	
			If (lngPerms And dbSecReplaceData) = dbSecReplaceData Then _
				strPerms = AddString(strPerms, "dbSecReplaceData")
	
			If (lngPerms And dbSecDeleteData) = dbSecDeleteData Then _
				strPerms = AddString(strPerms, "dbSecDeleteData")
	
		Case 2
			' Object is database.
			If (lngPerms And dbSecDBOpen) = dbSecDBOpen Then _
				strPerms = AddString(strPerms, "dbSecDBOpen")
	
			If (lngPerms And dbSecDBExclusive) = dbSecDBExclusive Then _
				strPerms = AddString(strPerms, "dbSecDBExclusive")

			If (lngPerms And dbSecDBAdmin) = dbSecDBAdmin Then _
				strPerms = AddString(strPerms, "dbSecDBAdmin")
			
		Case 3
			' Object is container.
			If (lngPerms And dbSecWriteOwner) = dbSecWriteOwner Then _
				strPerms = AddString(strPerms, "dbSecWriteOwner")
	
			If (lngPerms And dbSecCreate) = dbSecCreate Then _
				strPerms = AddString(strPerms, "dbSecCreate")
			
		Case Else
			' Unknown object, pass the permissions back.
			strPerms = CStr(lngPerms)
	End Select
	
	DecodePerms = strPerms
End Function

Function AddString(strCurrent As String, strIn As String) As String
	Dim strPerms As String

	If strCurrent = "" Then
			strPerms = strIn
	Else
			strPerms = strCurrent & "," & strIn
	End If
 
	AddString = strPerms
End Function

This works as follows:

The ShowPermissionsAsText procedure iterates through each object and retrieves the value of the Permissions property.
This value is sent to the DecodePerms function, which compares it to the permission constants for that particular object type.
The DecodePerms function calls the AddString function to add the text representation of the permission name to a string, and returns it to the DecodePerms function.
The DecodePerms function takes the final concatenated string and passes it back to the ShowPermissionsAsText procedure for display.

Note The DecodePerms function decodes permissions only for Microsoft Jet-specific objects. You can modify it to include other application-defined permissions, such as those defined by Microsoft Access for Microsoft Access-specific objects.