关于会签
这是一个并发的文件会签程序,请帮我看看问题出在哪?会签人员接到文档后,在视图中看到文档标题,但无法点开连接,批阅文档,点击视图中的标题就出现“该页无法显示”
Sub Initialize
On Error Goto Errhandle
Dim session As New NotesSession
Dim doc As NotesDocument
Dim Maildoc As NotesDocument
Dim doc1 As NotesDocument
Dim docConfigure As NotesDocument
Dim vfldNextUsersCount As Variant
Dim vfldNextUsers As Variant
Dim mdocid As String
Dim item As NotesItem
Dim k As Integer
Dim CurDb As NotesDatabase
Dim MailDb As NotesDatabase
Dim gwsendform, gwsendto As Variant
Set doc = session.DocumentContext
Set CurDb = session.CurrentDatabase
Set db = session.GetDatabase( "", "oaconfig.nsf" )
Set view = db.GetView( "viewFwConfigure" )
' note.SaveOptions = 0
'If doc.HasItem("$$Return") Then
' doc.RemoveItem("$$Return")
'End If
Dim vfldNextStep As Variant
Dim vfldCurrStep As Variant
vfldNextStep = doc.fldNextStep
vfldCurrStep = doc.fldCurrStep
Set docConfigure = view.GetDocumentByKey( vfldCurrStep(0))
i = 0
While (i < Cint(doc.tempSelectIndex(0)))
Set docConfigure = view.GetNextDocument( docConfigure )
i = i + 1
Wend
Dim vtmpfldNextNo0 As Variant
Dim vtmpfldNo0 As Variant
vtmpfldNextNo0 = docConfigure.fldNextNo
vtmpfldNo0 = docConfigure.fldNo
doc.fldPrevStep = doc.fldCurrStep
doc.nextdbsxdatabase = doc.dbsxdatabase
Messagebox("2")
If (vtmpfldNextNo0(0) = "0") Then
doc.Form = "delete"
Else
Messagebox("3")
Set docConfigure1 = view.GetDocumentByKey( vtmpfldNextNo0(0))
Dim vtmpTypeSubject As Variant
Dim vtmpTypeContent As Variant
Dim vtmpTypeAttachment As Variant
Dim vtmpTypeComment As Variant
Dim vtmpfldNo As Variant
Dim vtmpfldNextNo As Variant
vtmpTypeSubject = docConfigure1.fldTypeSubject
vtmpTypeContent = docConfigure1.fldTypeContent
vtmpTypeAttachment = docConfigure1.fldTypeAttachment
vtmpTypeComment = docConfigure1.fldTypeComment
vtmpfldNo = docConfigure1.fldNo
vtmpfldNextNo = docConfigure1.fldNextNo
Messagebox("4")
doc.open_type_subject = vtmpTypeSubject
doc.open_type_content = vtmpTypeContent
doc.open_type_attachment = vtmpTypeAttachment
doc.open_type_comment = vtmpTypeComment
doc.fldCurrStep = vtmpfldNo
doc.fldNextStep = vtmpfldNextNo
gwsendfrom = doc.LoginUser
gwsendto = doc.fldNextUsers
vfldNextUsers=doc.fldNextUsers
Messagebox("5")
vfldNextUsersCount=doc.fldNextUsersCount
k=Val(vfldNextUsersCount(0))-1
'增加流程
result = AddFWTrace(doc.docauthor , doc.fldSelectOperation(0), doc.fldNextUsers )
If Not result Then
Exit Sub
End If
'vfldNextUsersCount=vfldNextUsersCount+1
'added by ljc 2002,5,27 以下是并发处理,将主文档复制n份,并把子文档的作者姓名添加到主文档的作者域中,而子文档的
'读者域也是它本人,发送链接至各人,然后改变主文档的角色
Set item = doc.GetFirstItem( "docauthor" )
Set item1=doc.GetfirstItem("docreader")
Dim newDoc As NotesDocument
Messagebox(k)
For i=0 To k
Messagebox("7")
Set doc1 = CurDb.CreateDocument
Call doc.CopyAllItems( doc1, True )
doc1.docauthor=vfldNextUsers(i)
doc1.docreader=vfldNextUsers(i)
doc1.mdocid=doc.UniversalID
doc1.fldDocID="f"+doc1.UniversalID
Call item.AppendToTextList(vfldNextUsers(i))
item.IsAuthors=True
Call item1.AppendToTextList(vfldNextUsers(i))
item1.IsReaders=True
doc1.childflag="1"
doc1.fldNextUsersCount="1"
doc1.oldcomment = ""
doc1.fldNextUsers = ""
doc1.tempSelectRole = ""
doc1.fldSelectUser = ""
'置发送时间
doc1.fldCurrDate = doc1.fldFsSj(0)
'会签子文档的邮件文档(void)
Set newDoc = New NotesDocument(CurDb )
doc1.dbsxformid = "d" + newDoc.UniversalID '会签子文档记录邮件ID
Call doc1.save(True,True)
'向接受人的邮箱发送链接
newDoc.Form = "index"
newDoc.Subject = doc1.subject(0)
newDoc.Principal = gwsendfrom
newDoc.SendTo = vfldNextUsers(i)
newDoc.dbn = "gzl1.nsf"
newDoc.viewname = "viewFwDocID"
newDoc.docid = doc1.fldDocID
newDoc.api_wb_wdlx = doc.form_type(0)
'Messagebox(vfldNextUsers(i)+"="+doc1.fldDocID)
newDoc.Send(False)
Messagebox("8")
Next
'end ljc 2002,5,27
''''将主文档置于下一个状态,等待子文档的答复begin
Set docConfigure1 = view.GetDocumentByKey( vtmpfldNextNo(0))
doc.fldPrevStep = doc.fldCurrStep
vtmpTypeSubject = docConfigure1.fldTypeSubject
vtmpTypeContent = docConfigure1.fldTypeContent
vtmpTypeAttachment = docConfigure1.fldTypeAttachment
vtmpTypeComment = docConfigure1.fldTypeComment
vtmpfldNo = docConfigure1.fldNo
vtmpfldNextNo = docConfigure1.fldNextNo
doc.open_type_subject = vtmpTypeSubject
doc.open_type_content = vtmpTypeContent
doc.open_type_attachment = vtmpTypeAttachment
doc.open_type_comment = vtmpTypeComment
doc.fldCurrStep = vtmpfldNo
doc.fldNextStep = vtmpfldNextNo
'''end将主文档置于下一个状态,等待子文档的答复
'向当前人的邮箱发送链接
If doc.dbsxformid(0) <> "" Then
Set MailDb = session.GetDatabase( "", doc.dbsxdatabase(0) )
Set MailView = MailDb.GetView( "viewIndexDocid" )
Set Maildoc = MailView.GetDocumentByKey( doc.dbsxformid(0) )
If Not (Maildoc Is Nothing ) Then
Maildoc.api_wb_wdlx="会签待答复"
Call Maildoc.Save( True ,True)
End If
Else
Set newDoc = New NotesDocument(CurDb )
doc.dbsxformid = "d" + newDoc.UniversalID
newDoc.Form = "index"
newDoc.Subject = doc.subject(0)
newDoc.Principal = gwsendfrom
newDoc.SendTo = doc.loginUser
newDoc.dbn = "gzl1.nsf"
newDoc.viewname = "viewFwDocID"
newDoc.docid = doc.fldDocID
newDoc.api_wb_wdlx = "会签待答复"
'Messagebox(vfldNextUsers(i)+"="+doc1.fldDocID)
newDoc.Send(False)
End If
doc.fldCurrDate = doc.fldFsSj(0)
Messagebox("end")
End If
Exit Sub
Errhandle:
Print "<br>"
Print "parallel Agent Error In Line:" & Str(Erl) & " " & Str(Err) & ": " & Error$
End Sub