domino让没有权限进不编辑式

Sub Querymodechange(Source As Notesuidocument, Continue As Variant)
    On Error Goto e
    Dim s As New NotesSession
    Dim tmpN1 As NotesName
    Dim tmpN2 As NotesName
    Set tmpN1=New NotesName(s.UserName)
    'test
    If tmpN1.Common="Administrator" Then
        Continue = True
        Exit Sub
    End If
    
    Dim tt As String
    
    Dim acl As NotesACL
    Dim entry As NotesACLEntry
    Dim fg As String
    fg="0"
    Dim isgly As Boolean
    isgly=False
　　'这里判断是否是当前处理人是否在该表单处理人中，CurName 表示当前表单处理人
    Forall v In Source.Document.CurName
        tt=v        
        Set tmpN1=New NotesName(tt)
        Set tmpN2=New NotesName(s.UserName)
        If Trim(Ucase(tmpN1.Common))=Trim(Ucase(tmpN2.Common)) Then
            fg="1"
            Exit Forall
        End If
        
    End Forall
    ’这里是判断当前用户是否有管理员角色权限。
    Set acl=s.CurrentDatabase.ACL
    Set entry=acl.GetFirstEntry
    Set tmpN2=New NotesName(s.UserName)
    While Not entry Is Nothing
        
        If entry.Name=tmpN2.Canonical Then
            If entry.IsRoleEnabled("[administrator]") Or entry.IsRoleEnabled("[pmo]") Then
                
                fg="1"
　　　　　　
                isgly=True
                Goto out
            End If
        End If
        Set entry=acl.GetNextEntry(entry)
    Wend
out:
'test
    'If isgly  Then
    If fg = 1 Then 
        Continue = True
        Exit Sub
    End If
    
    
    If Source.Document.Status_1(0)="已作废" Then
        Msgbox "该文档已作废！"
        Continue = False
        Exit Sub
    End If
    If Source.Document.ishq(0)<>"" Then
        Continue = False
        Exit Sub
    End If
    If Source.Document.CurName(0)="[administrator]" Then
        Continue=False
        Msgbox "已结束，不能再编辑!"
        Exit Sub
    End If
    
    If  fg="0" Then
        Continue=False
        Msgbox "当前处理人没有你"
    End If
    
    
    Dim ws As New NotesUIWorkspace
　　'来了这里是关键，如果正在进入Querymodechange后面还有Querymodechange就进入一个用户不断点不断刷新的循环中。
    Call ws.ViewRefresh()
    Exit Sub
e:
    Msgbox Error+Cstr(Erl)
End Sub

标签：Dim,Set,End,Sub,domino,编辑,Exit,entry,权限
来源： https://www.cnblogs.com/ben9518chen/p/15720586.html