[AP] Run On Server 利用定義RunAgents來執行 (S+)

'//Run On Server

在表單動作裡：
Call MailSend(SendTo, CopyTo, strSubject, Remark, SourceDoc, True)

'//--------------將子表單的flag更新--------------
Dim agUpd As NotesAgent, paramID As String
Set agUpd = SourceDB.GetAgent("agRunOnServer")
paramid = SourceDoc.Noteid
'//RunOnServer
'Call SourceDoc.ReplaceItemValue("RunAgents", "UPDATE_SUBDOCFLAG")
'If paramID <> "" Then
' 'Call agUpd.RunOnServer(paramID)
' Call agUpd.Run()
'End If
'--------------------------------------------------------------

jmcuidoc.AutoReload = True
Call jmcuidoc.Reload
Call jmcuidoc.save
SourceDoc.saveoptions = "0"
Call jmcuidoc.close


在agent增加：(agRunOnServer)，條件設為一天執行多次，新文件或修改文件時執行
[Options]
Option Public Option Declare Use "JWFSCAgentEvent"

[Initialize]

Sub Initialize '//RunOnServer Dim session As New notessession Dim agent As notesagent, IssueDB As NotesDatabase, IssueDoc As NotesDocument Set agent = session.CurrentAgent Set IssueDb = session.CurrentDatabase Print "RunOnServer " + agent.Name + " start..." + Now() Print IssueDb.Filepath+"!!"+agent.Name Call RunAgentsOnServer() Print "RunOnServer " + agent.Name + " end..." + Now() End Sub

在Script Libraries增加：JWFSCAgentEvent

[Options]

Option Public

Option Declare

Use "JWFSCLinkHotSpot"

Use "JMCSCACL"

Use "SP.wfLibV2"

Use "AgnesLibrary"

[Declarations]

Public maildoc As NotesDocument Public rt1 As NotesRichTextItem

[Functions]

'//RunAgentsOnServer的機制

Function RunAgentsOnServer() As Integer ' * 此代理程式給給予程式設計師增加自訂客製化程式交給伺服代理處理文件更新事情 ' 欲執行的工作請放在 RunAgents 欄位內 On Error Goto ErrorHandler Call jmcf_blnSetNewVars() '初始環境變數 Dim RunAgentsView As NotesView, tmpdoc As NotesDocument, i As Integer Dim RunAction As Variant Dim sysdoc As NotesDocument RunAgentsOnServer = False Print "RunOnServer - run RunAgentsOnServer start......." + Now() Set RunAgentsView = jmcdb.GetView("View-RunAgents") If RunAgentsView Is Nothing Then Print "not found view: View-RunAgents !!" : Exit Function ' Set sysdoc = GetSystemDocument("Form-SystemSetup") If sysdoc Is Nothing Then Print "not found SystemSetup doc!!" : Exit Function Set jmcdoc_Source = RunAgentsView.GetFirstDocument If jmcdoc_Source Is Nothing Then Print "not found RunAgents doc!!" : Exit Function '//----------------------Lock Document-------------------------- If (jmcdoc_Source.Lock_Flag(0) = "Y") And (jmcdoc_Source.WhoLock(0) <> "") Then Exit Function Else Print "agent Lock start by " + jmcdb.Server Call jmcdoc_Source.ReplaceItemValue("Lock_Flag", "Y") Call jmcdoc_Source.ReplaceItemValue("WhoLock", jmcdb.Server) Call jmcdoc_Source.save(True, True) End If '------------------------------------------------------------------------- While Not jmcdoc_Source Is Nothing Set tmpdoc = RunAgentsView.GetNextDocument(jmcdoc_Source) RunAction = jmcdoc_Source.RunAgents For i = 0 To Ubound(jmcdoc_Source.RunAgents) Select Case Ucase(jmcdoc_Source.RunAgents(i)) ' --------------------* 請將你要客製化執行的程式放在這裡------------------------------------------------ Case "INSERT_QCACTION" If INSERT_QCACTION(jmcdoc_Source) Then RunAction = SP_AryDelVItem(RunAction, jmcdoc_Source.RunAgents(i)) Else Call WriteMail("文件編號:" + jmcdoc_Source.SerialNumber(0) + "在INSERT ERunCard table時發生錯誤",jmcdoc_Source) Set jmcdoc_Source = tmpdoc Goto NextDo End If ' If Update_PCBNo(jmcdoc_Source) Then ' RunAction = SP_AryDelVItem(RunAction,jmcdoc_Source.RunAgents(i)) ' Else ' Call WriteMail("文件編號:" + jmcdoc_Source.pwcDocSeqNo(0) + "在Update 加雕/加洗次數時發生錯誤",jmcdoc_Source) ' Set jmcdoc_Source=tmpdoc' ' Goto NextDo ' End If ' -------------------- ** 客製化到這裡結束 ---------------------------------------------------------------------------- Case Else Print "錯誤的執行代碼("+jmcdoc_Source.RunAgents(i)+")" RunAction = SP_AryDelVItem(RunAction,jmcdoc_Source.RunAgents(i)) End Select Next ' jmcdoc_Source.RunAgents = RunAction '更新剩餘工作 '//---------------UnLock-------------- Call jmcdoc_Source.ReplaceItemValue("Lock_Flag", "") Call jmcdoc_Source.ReplaceItemValue("WhoLock", "") Print "agent unLock end by " + jmcdb.Server '------------------------------------------ jmcdoc_Source.Save True,True Set jmcdoc_Source=tmpdoc Nextdo: Wend RunAgentsOnServer = True TheEnd: Print "RunOnServer - run RunAgentsOnServer end......." + Now() If Not maildoc Is Nothing Then Dim tempSendto As Variant 'tempSendto = SP_TransEmailAdr(jmcf_vntGetRolesList(jmcdb,"[SYSAdmin]")) tempSendto = sysdoc.ItmEmpEName If tempSendTo(0) <> "" Then Call maildoc.Send(False, tempSendTo) End If End If Exit Function ErrorHandler: RunAgentsOnServer = False Print "lib: JWFSCAgentEvent: RunAgentsOnServer error line = " + Cstr(Erl) + ", error = " + Error$ Resume TheEnd End Function

'//若發生異常時的mail通知

Function WriteMail(strText As String,mdoc As notesDocument)

On Error Goto ErrorHandler

Dim URL As New SP_URLHotSpot("","")

If Maildoc Is Nothing Then 

Set Maildoc = New NotesDocument(jmcdb)

Set rt1 = New NotesRichTextItem(Maildoc,"body")

maildoc.Form="Memo"

maildoc.Subject = jmcdb.Title + "有下列申請單發生錯誤，請儘速查明以免影資料正確性!!"

rt1.AddNewLine(1)

rt1.AppendText("==================================================")

rt1.AddNewLine(1)

End If

rt1.AppendText(strText)

If  Not mdoc Is Nothing Then 

Call URL.SetHref(URL.MakeDocLink("Notes", mdoc, Nothing  , ""))

Call URL.AppendURLHotSpot(rt1)

Call URL.SetLabel ("按我連結")

Call URL.AppendURLHotSpot(rt1)

End If

rt1.AddNewLine(1)

TheEnd:

Exit Function 

ErrorHandler:

Print "Library:JWFSCAgentEvent-WriteMail()"

'Call SP_ErrHandle("Library:JWFSCAgentEvent-WriteMail()",jmcdoc_Source)     

Resume TheEnd  

End Function

'//實際要處理的行為

Function INSERT_QCACTION(pdoc As NotesDocument) As Integer '//在送審時，將子文件的DocFlag = "T"→"P" On Error Goto errorhandler Call jmcf_blnSetNewVars() Dim SourceDoc As NotesDocument, SourceDB As NotesDatabase Dim vi As NotesView, tdoc As NotesDocument, tcol As NotesDocumentCollection ' Set SourceDB = jmcdb Set SourceDoc = jmcdoc_Source INSERT_QCACTION = True Print "RunOnServer - run Update_SubDocFlag start......." + Now() Set vi = SourceDB.GetView("View-SubDocFlagbyUniqueID") If vi Is Nothing Then Error 997, "not found view: View-SubDocFlagbyUniqueID!!" Set tcol = vi.GetAllDocumentsByKey(pdoc.pwcUniqueID(0), True) If tcol.Count = 0 Then Print "not found View-SubDoc!!" : Exit Function Set tdoc = tcol.GetFirstDocument If tdoc Is Nothing Then Error 997, "not found View-SubDocFlagbyUniqueID doc!!" Do While Not tdoc Is Nothing Call tdoc.ReplaceItemValue("DocFlag", "P") Call tdoc.Save(True, False) Set tdoc = tcol.GetNextDocument(tdoc) Loop Print "RunOnServer - run Update_SubDocFlag end......." + Now() TheEnd: Exit Function ErrorHandler: INSERT_QCACTION = False Print "lib: JWFSCAgentEvent: RunAgentsOnServer: Update_SubDocFlag error line = " + Cstr(Erl) + ", error = " + Error$ 'Call SP_ErrorBox("lib: SP.ReferenceAction4BA: SP_UpdateSubDocFlag error") Resume TheEnd End Function