VBA/Excel/Access/Word/Application/Office Permmison

Add users

   <source lang="vb">

Sub AddUsers()

   Dim myPermission As Office.Permission, usr As Office.UserPermission
   Set myPermission = ThisWorkbook.Permission
   myPermission.RemoveAll
   myPermission.Add "someone@hotmail.ru", MsoPermission.msoPermissionView
   Set usr = myPermission.Add("ExcelDemo@hotmail.ru", MsoPermission.msoPermissionView)
   usr.Permission = MsoPermission.msoPermissionPrint Or MsoPermission.msoPermissionExtract
   Set usr = myPermission("ExcelDemo@hotmail.ru")
   usr.ExpirationDate = Date + 1

End Sub

</source>
   
  

Enable permission

   <source lang="vb">

Sub RestrictPermission()

   Dim myPermission As Office.Permission, wb As Workbook
   Set myPermission = ThisWorkbook.Permission
   myPermission.Enabled = True

End Sub

</source>
   
  

Remove Permissions

   <source lang="vb">

Sub RemovePermissions()

   Dim myPermission As Office.Permission
   Set myPermission = ThisWorkbook.Permission
   myPermission.Enabled = False

End Sub

</source>
   
  

Set office Permission

   <source lang="vb">

Sub SetPermission()

   Dim irm As Office.Permission
   Dim usr As Office.UserPermission
   Set irm = ActiveWorkbook.Permission
   For Each usr In irm
       Debug.Print usr.UserId, usr.Permission, usr.ExpirationDate
   Next
       Debug.Print irm.DocumentAuthor, irm.RequestPermissionURL

End Sub

</source>
   
  

Show Permissions

   <source lang="vb">

Sub ShowPermissions() " From Help

   Dim myPermission As Office.Permission
   Set myPermission = ActiveWorkbook.Permission
   If myPermission.Enabled Then
       If myPermission.PermissionFromPolicy Then
           Debug.Print "Policy name: " & myPermission.PolicyName 
           Debug.Print "Policy description: " & myPermission.PolicyDescription
       Else
           Debug.Print "Default policy name: " & myPermission.PolicyName 
           Debug.Print "Default policy description: " & myPermission.PolicyDescription
       End If
   Else
       Debug.Print "Permission are NOT restricted on this document."
   End If
   Set myPermission = Nothing

End Sub

</source>
   
  

Show User Permissions

   <source lang="vb">

Sub ShowUserPermissions()

   Dim myPermission As Office.Permission, usr As Office.UserPermission
   Set myPermission = ThisWorkbook.Permission
   Debug.Print "User", , "Permission", "Permission Expires"
   Set usr = myPermission("ExcelDemo@Hotmail.ru")
   usr.Permission = MsoPermission.msoPermissionChange Or MsoPermission.msoPermissionPrint
   For Each usr In myPermission
       Debug.Print usr.UserId, usr.Permission, usr.ExpirationDate
   Next
   Debug.Print myPermission.DocumentAuthor, myPermission.RequestPermissionURL

End Sub

</source>
   
  

The Permission of current workbook

   <source lang="vb">

Sub ShowPermissions()

   Dim myPermission As Office.Permission, str As String
   Set myPermission = ThisWorkbook.Permission
   If myPermission.Enabled Then
       If myPermission.PermissionFromPolicy Then
           Debug.Print "Policy name: " & myPermission.PolicyName
           Debug.Print "Policy description: " & myPermission.PolicyDescription
       Else
           Debug.Print "Default policy name: " & myPermission.PolicyName
           Debug.Print "Default policy description: " & myPermission.PolicyDescription
       End If
   Else
       Debug.Print "Permission are NOT restricted on this document."
   End If

End Sub

</source>