|
|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。如果您注册时有任何问题请联系客服QQ: 83569622 。
您需要 登录 才可以下载或查看,没有帐号?注册
x
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim allcollection As NotesDocumentCollection
Dim sCondition As String
Dim item_A As NotesItem
Dim item_R As NotesItem
' Dim user1 As New NotesName(session.UserName) '增加的代码
On Error Goto ErrorCleanup
Set doc = session.DocumentContext
If doc Is Nothing Then
Msgbox "Can't get the DocumentContext!"
Print "Can't get the DocumentContext!"
Exit Sub
End If
Set db = session.CurrentDatabase
Call db.UpdateFTIndex(False) '有时你不需要调此函数
Dim Sea_form As String
Sea_form ="form=""gzrc""" '查询通知表单
Set allcollection = db.Search(Sea_form,Nothing, 0)
On Error Resume Next
Call allcollection.RemoveAllFromFolder("MultiView")
On Error Goto ErrorCleanup
sCondition = "( FIELD Apply_Men CONTAINS " + doc.cx_name(0) + ")"
If doc.subsubject(0)<>"" Then
If sCondition<>"" Then sCondition = sCondition + " & "
sCondition = sCondition+"( FIELD Object CONTAINS "+ doc.subsubject(0) +")"
End If '标题
If doc.subcategories(0)<>"" Then
If sCondition<>"" Then sCondition = sCondition + " & "
sCondition = sCondition+"( FIELD Object_class CONTAINS "+ doc.subcategories(0) +")"
End If '分类
If doc.subpubman(0)<>"" Then
If sCondition<>"" Then sCondition = sCondition + " & "
sCondition = sCondition+"( FIELD Apply_Men CONTAINS "+ doc.subpubman(0) +")"
End If '公布人
If doc.subworkplace(0)<>"" Then
If sCondition<>"" Then sCondition = sCondition + " & "
sCondition = sCondition+"( FIELD Content CONTAINS "+ doc.subworkplace(0) +")"
End If '内容
If Trim(doc.subksrq(0))<>"" Then
If Not Isdate(doc.subksrq(0)) Then
Call UOWebMsg("所输入的开始日期不是日期格式,请检查!")
Exit Sub
End If
End If
If Trim(doc.subjsrq(0))<>"" Then
If Not Isdate(doc.subjsrq(0)) Then
Call UOWebMsg ("所输入的结束日期不是日期格式,请检查!")
Exit Sub
End If
End If
If (Trim(doc.subjsrq(0))="" And Trim(doc.subksrq(0))<>"") Or (Trim(doc.subjsrq(0))<>"" And Trim(doc.subksrq(0))="") Then
Call UOWebMsg ("所输入的开始结束日期均不能为空,请检查!")
Exit Sub
End If
If (doc.subjsrq(0)< doc.subksrq(0)) Then
Call UOWebMsg ("结束日期不应该小于开始日期,请检查!")
Exit Sub
End If
If sCondition<>"" Then
Call allcollection.FTSearch(sCondition, 0)
If allcollection.Count > 0 Then
Dim doc8 As NotesDocument
For i=1 To allcollection.Count
Set doc8 = allcollection.GetNthDocument(i)
If Trim(doc.subksrq(0))<>"" And Trim(doc.subjsrq(0))<>"" Then
If (doc8.Apply_Date(0)>=Cdat(doc.subksrq(0))) And (doc8.Apply_Date(0)<=Cdat(doc.subjsrq(0))) Then
Call doc8.PutInFolder("MultiView")
End If
Else
Call doc8.PutInFolder("MultiView")
End If
Next
End If
Else
If Trim(doc.subksrq(0))<>"" And Trim(doc.subjsrq(0))<>"" Then
If allcollection.Count > 0 Then
Dim doc9 As NotesDocument
For i=1 To allcollection.Count
Set doc9 = allcollection.GetNthDocument(i)
If (doc9.Apply_Date(0)>=Cdat(doc.subksrq(0))) And (doc9.Apply_Date(0)<=Cdat(doc.subjsrq(0))) Then
Call doc9.PutInFolder("MultiView")
End If
Next
End If
End If
End If
Exit Sub
ErrorCleanup:
'Msgbox Error$
'Print Error$
Exit Sub
End Sub |
|