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

Add users

 
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

Enable permission

 
Sub RestrictPermission()
    Dim myPermission As Office.Permission, wb As Workbook
    Set myPermission = ThisWorkbook.Permission
    myPermission.Enabled = True
End Sub

Remove Permissions

 
Sub RemovePermissions()
    Dim myPermission As Office.Permission
    Set myPermission = ThisWorkbook.Permission
    myPermission.Enabled = False
End Sub

Set office Permission

 
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

Show Permissions

 
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

Show User Permissions

 
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

The Permission of current workbook

 
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