domino双击邮件打开流程而不用打开邮件再打开流程

Sub Postopen(Source As Notesuidocument)
    If source.InPreviewPane Then Exit Sub
    Call cMemoObject.PostOpen(Source)    
    
    If source.isnewdoc Then
        Call source.refresh(False, False, True)
    End If
    On Error Goto e
    If Not source.IsNewDoc Then
        
        Dim rti As NotesRichTextItem
        Dim rtnav As NotesRichTextNavigator
        Dim rtlink As NotesRichTextDocLink
        
        Set rti = source.Document.GetFirstItem("Body")
        Set rtnav = rti.CreateNavigator
        If Not rtnav.FindFirstElement(RTELEM_TYPE_DOCLINK) Then
                'Msgbox "没找到流程连接"
            Exit Sub
        End If
        
        Set rtlink = rtnav.GetElement
        If rtlink.DocUNID = String$(32, "0") Then
            Exit Sub
        End If
        
        Dim sse As New NotesSession
        Dim linkDb As New NotesDatabase("", "")
        
        If Not linkDb.OpenByReplicaID(rtlink.ServerHint, rtlink.DbReplicaID) Then
            Exit Sub
        End If
        Dim linkDoc As NotesDocument
        Set linkDoc = linkDb.GetDocumentByUNID(rtlink.DocUNID)
        '===============edit mode
        Dim curname As NotesName
        Dim tmpname As NotesName
        Dim se As New notessession
        Dim fg As Boolean
        Dim edfg As Boolean
        fg=False
        If linkDoc.Status_1(0)="已作废" Then
            fg=True
        End If
        If linkDoc.ishq(0)<>"" Then
            fg=True
        End If
        If linkDoc.CurName(0)="[administrator]" Then
            fg=True
        End If
        
        If fg Then
            edfg=False
        Else
            Set curname=New NotesName(se.UserName)
            Forall v In linkDoc.CurName            
                Set tmpname=New NotesName(v)
                If Ucase(tmpname.Common)=Ucase(curname.Common) Then
                    edfg=True
                    Exit Forall
                End If
            End Forall
        End If
        
    End If    
    source.Close(True)
    Dim ws As New NotesUIWorkspace
    Call ws.EditDocument(edfg,linkDoc)
    Exit Sub
e:
    Print  Error+Cstr(Erl)
    Resume Next
End Sub