Checking Permissions for a Specific Object
Sub GetObjectPermissions(strUserName As String, varObjName As Variant, lngObjType As ADOX.ObjectTypeEnum) Dim conn As ADODB.Connection Dim cat As ADOX.Catalog Dim strDB As String Dim strSysDb As String Dim listPerms As Long Dim strPermsTypes As String On Error GoTo ErrorHandle strDB = CurrentProject.Path & "\mydb.mdb" strSysDb = CurrentProject.Path & "\mydb.mdw" Set conn = New ADODB.Connection With conn .Provider = "Microsoft.Jet.OLEDB.4.0" .Properties("Jet OLEDB:System Database") = strSysDb .Properties("User ID") = "Developer" .Properties("Password") = "mypass" .Open strDB End With Set cat = New ADOX.Catalog cat.ActiveConnection = conn cat.Users.Append "PowerUser", "star" listPerms = cat.Users(strUserName) _ .GetPermissions(varObjName, lngObjType) Debug.Print listPerms If (listPerms And ADOX.RightsEnum.adRightCreate) = adRightCreate Then Debug.Print "adRightCreate" & vbCr End If If (listPerms And RightsEnum.adRightRead) = adRightRead Then Debug.Print "adRightRead" & vbCr End If If (listPerms And RightsEnum.adRightUpdate) = adRightUpdate Then Debug.Print "adRightUpdate" & vbCr End If If (listPerms And RightsEnum.adRightDelete) = adRightDelete Then Debug.Print "adRightDelete" & vbCr End If If (listPerms And RightsEnum.adRightInsert) = adRightInsert Then Debug.Print "adRightInsert" & vbCr End If If (listPerms And RightsEnum.adRightReadDesign) = adRightReadDesign Then Debug.Print "adRightReadDesign" End If ExitHere: Set cat = Nothing conn.Close Set conn = Nothing Exit Sub ErrorHandle: If Err.Number = -2147467259 Then Resume Next Else MsgBox Err.Description Resume ExitHere End If End Sub