2014年11月10日 星期一

[AP] 在rtf欄位上顯示搜尋結果

'//在rtf欄位上顯示搜尋結果
此動作建立套表的動作上


Sub Click(Source As Button)
Call Init_FrontVar
Call Init_BackVar
Dim strSearch As String

strSearch = {form="fAPSetup" & TransferFlag!="N"}
If ytdoc.APKind1(0) <> "" Then strSearch = strSearch + { & @IsMember("} & ytdoc.APKind1(0) & {"; APKind1) }
If ytdoc.APName(0) <> "" Then strSearch = strSearch + { & @Contains(@UpperCase(APName); "} & Ucase(ytdoc.APName(0)) & {") }

If ytdoc.APKind2(0) <> "" Then 
Dim xi As Integer, strKind As String
xi = 1
strKind = ""
Forall x In ytdoc.APKind2 
If xi = 1 Then
strKind = { & ( @IsMember("} & x & {"; APKind2) }
Else
strKind = strKind + { | @IsMember("} & x & {"; APKind2) }
End If
xi = xi + 1
End Forall

strKind = strKind + { ) }
strSearch = strSearch + strKind
End If

'Msgbox {strSearch: } & strSearch

Print "正在搜尋中,請稍候...."

Set ytdc = ytdb.search(strSearch, Nothing, 0)
Print ""
If ytdc.count = 0 Then
Msgbox "查無符合條件之文件!",64,"訊息提示"
Set ytdc = Nothing
Exit Sub
End If

Dim ii As Integer
Dim linkdb As notesdatabase
Dim ytnewdoc As New notesdocument(ytdb)
Dim rtitem As New NotesRichTextItem( ytnewdoc, "Body")

ytnewdoc.Form = "fDeleteAPSearch"
ytnewdoc.DeleteDate = ytnewdoc.Created
ytnewdoc.DeleteUser = yts.username

'Body表頭設定
Call rtitem.AppendText(" ")
Call rtitem.AddTab(1)
Call rtitem.AppendText("大分類")
Call rtitem.AddTab(3)
Call rtitem.AppendText("小分類")
Call rtitem.AddTab(3)
Call rtitem.AppendText("系統名稱")
Call rtitem.AddNewline(1)

Call rtitem.AppendText(" ")
Call rtitem.AddTab(1)
Call rtitem.AppendText("========")
Call rtitem.AddTab(2)
Call rtitem.AppendText("========")
Call rtitem.AddTab(2)
Call rtitem.AppendText("=======================================")
Call rtitem.AddNewline(1)

'表身資料
On Error Resume Next
For ii = 1 To ytdc.count 
Set linkdb = Nothing
Set ytdcdoc = ytdc.GetNthDocument(ii)
'Set linkdb = yts.getdatabase( ytdcdoc.DBLocateDefault(0), ytdcdoc.DBPath(0) )
Set linkdb = New NotesDatabase( ytdcdoc.DBLocateDefault(0), ytdcdoc.DBPath(0) )
'If Cstr(Err)="4060"  Then Goto NextRow
If linkdb Is Nothing Then Goto NextRow
If linkdb.CurrentAccessLevel = 0 Then Goto NextRow

Call rtitem.AppendDocLink(ytdcdoc, "")
Call rtitem.AppendText(Space$(2))
Call rtitem.AppendDocLink(linkdb, "")
Call rtitem.AddTab(1)

Call rtitem.AppendText( Leftbp$(ytdcdoc.APKind1(0)+Space$(30), 30) )
Call rtitem.AddTab(1)

If ytdcdoc.APKind2(0) = "" Then
Call rtitem.AddTab(3)
Else
Call rtitem.AppendText( Leftbp$(ytdcdoc.APKind2(0)+Space$(30), 30) )
Call rtitem.AddTab(1)
End If

Call rtitem.AppendText( ytdcdoc.APName(0) )

Call rtitem.AddNewline(1)

NextRow:
'Messagebox Cstr(Err)

Next

Call ytnewdoc.Save(True, False)

Set ytdc = Nothing
Call ytuidoc.close
Call ytw.editdocument(True, ytnewdoc)

End Sub

沒有留言:

張貼留言