关于答复文档和父文档的相互打开

[xiaoyuer0851]

在编程过程中，经常会遇到客户提需求，要求在录入答复文档后能够返回到选择录入答复文档的界面，我摸索了一下，代码如下：

/*viewziliao 查看答复文档

Sub Initialize
On Error Goto Errhandle
Dim session As New NotesSession
Dim doc,responsedoc As NotesDocument
Dim profiledoc As NotesDocument
Dim db As notesdatabase
Dim dc As NotesDocumentCollection
Set db =session.currentdatabase
Set doc=session.documentcontext
Set dc =doc.responses
Set profiledoc =db.getprofiledocument("selectziliaoform")
ls_dbpath = db.filepath
If dc.count =0 Then '/没有答复文档
'Messagebox "企业没有录入内部资料" 在oaserver上体现
Print "[/"+ls_dbpath+"/messageboxform?openform&message=企业没有录入内部资料！]"
Exit Sub
End If
'/只有一个答复文档
If dc.count =1 Then
Set responsedoc =dc.getfirstdocument
If Not responsedoc Is Nothing Then
'Print "[/"+ls_dbpath+"/responsedoc?openform"+"responsedoc.UniversalID]"
Print "[/"+ls_dbpath+"/allview/"+responsedoc.Universalid+"?opendocument]"
End If
Exit Sub
End If
'/ 有多个答复文档则选择打开
If dc.count >1 Then
tempstr =""
Set responsedoc =dc.getfirstdocument
While Not responsedoc Is Nothing
tempstr=tempstr+"<li><a href='../chakanziliao?openagent&UniversalID="+_
responsedoc.UniversalID+"&subject="+responsedoc.Subject(0)+"'>"+responsedoc.subject(0)+"</a>"
Set responsedoc =dc.getnextdocument(responsedoc)
Wend
End If
Print tempstr
'profiledoc.selectziliao = "[<!-->"+tempstr+"<!-->]"
'Print "[/"+ls_dbpath+"/allview/"+profiledoc.Universalid+"?opendocument]"
'Print Evaluate(|@Command([Compose];profiledoc)|)
Exit Sub
Errhandle:
errortext = Str(Erl())+"："+ Error()
Print "[/"+ls_dbpath+"/messageboxform?openform&message="+errortext+"]"
End
Exit Sub
End Sub
/*******打开答复文档
Sub Initialize
On Error Goto Errhandle
Dim session As New NotesSession
Dim doc,note As NotesDocument
Dim db As notesdatabase
Set db =session.currentdatabase
Set doc=session.documentcontext
ls_dbpath = db.filepath
'Print doc.query_string_decoded(0)+"<br>"
mainstr=Left(Strrightback(doc.query_string_decoded(0),"&UniversalID="),32)
'Print mainstr
Set note =db.Getdocumentbyunid(mainstr)
'Print note.UniversalID
If Not note Is Nothing Then
Print "[/"+ls_dbpath+"/allview/"+note.Universalid+"?opendocument]"
End If
Exit Sub
Errhandle:
errortext = Str(Erl())+"："+ Error()
Print "[/"+ls_dbpath+"/messageboxform?openform&message="+errortext+"]"
End
Exit Sub
End Sub
/***********返回父文档

Sub Initialize
'On Error Resume Next
On Error Goto Errhandle
Dim session As New NotesSession
Dim doc,parentdoc As NotesDocument
Dim db As notesdatabase
Dim dc As NotesDocumentCollection
Dim i As Integer
Dim foldername,dbpath As String
Set db = session.currentdatabase
ls_dbpath = db.filepath
Set doc = Session.DocumentContext
Set parentdoc =db.getdocumentbyUnid(doc.parentdocumentUnid)
If Not parentdoc Is Nothing Then
Print "[/"+ls_dbpath+"/allview/"+parentdoc.Universalid+"?opendocument]"
End If
Exit Sub
Errhandle:
errortext = Str(Erl())+"："+ Error()
Print "[/"+ls_dbpath+"/messageboxform?openform&message="+errortext+"]"
End
Exit Sub
End Sub

[eq9684]

up!