[AP] 刪文件 if error 寄mail給系統負責人

'//刪文件 if error 寄mail給系統負責人

Function SP_DeleteDoc() As Integer
'//刪除SignStatus = "Cancel" & 7天以上的文件
On Error Goto errorhandler
Call jmcf_blnSetNewVars()
Dim SourceDB As NotesDatabase, CurrAG As NotesAgent, setupdoc As NotesDocument
Dim SendTo As Variant, CopyTo As Variant, strSubject As String, strRemark As String
Dim clsvi As NotesView, clsdoc As NotesDocument, nextdoc As NotesDocument, movdoc As NotesDocument
'
Set SourceDB = jmcdb
Set CurrAG = jmcSession.CurrentAgent 
'
SendTo = ""
CopyTo = ""

Set setupdoc = GetSystemDocument("Form-SystemSetup")
If setupdoc Is Nothing Then Print "not found setupdoc!!" : Exit Function

Set clsvi = SourceDB.GetView("View-CancelDoc")
If clsvi Is Nothing Then Error 997, "not found view: View-CancelDoc!!"
Set clsdoc = clsvi.GetFirstDocument()

Dim dtToday As New NotesDateTime(Today())
Do While Not clsdoc Is Nothing
Set nextdoc = clsvi.GetNextDocument(clsdoc)
Dim dtcancel As New NotesDateTime(clsdoc.CancelDate(0))
Call dtcancel.AdjustDay(7)
If dtcancel.DateOnly < dtToday.DateOnly Then
Set movdoc = clsdoc
Call movdoc.Remove(True)
End If
Set clsdoc = nextdoc
Loop



TheEnd:
Exit Function
ErrorHandler:
Dim strErr As String
strErr = SourceDb.Title + ": " + CurrAG.Name + ": SP_DeleteDoc error line = " + Cstr(Erl) + ", error = " + Error$
Print strErr
SendTo = setupdoc.ItmEmpEName
strSubject = SourceDb.Title + ": " + CurrAG.Name + ": SP_DeleteDoc error"
strRemark = strErr
Call MailSend(SendTo, CopyTo, strSubject, strRemark, clsdoc, True)
Resume TheENd
End Function

'//---------------------------------------------------------------------------

[Declaration]
Dim RTItem As NotesRichTextItem

Sub MailSend(SendTo As Variant, CopyTo As Variant, Subject As String, Remark As String, IncludeDoc As NotesDocument, PromptMessage As Variant)
On Error Goto ErrorHandler
Dim DB As NotesDatabase
Dim MailDoc As NotesDocument     
Dim UserDoc As NotesDocument
Call jmcf_blnSetNewVars()
Dim itemSendTo As NotesItem

Set DB = IncludeDoc.ParentDatabase     

Set UserDoc = New NotesDocument(DB)
UserDoc.Form = "Form-SwitchUserName"

Set MailDoc = New NotesDocument(DB)
MailDoc.Form = "Memo"

UserDoc.UserName = CopyTo
Call UserDoc.ComputeWithForm(True, True)
MailDoc.CopyTo = UserDoc.FullUserName

UserDoc.UserName = SendTo
Call UserDoc.ComputeWithForm(True, True)
MailDoc.SendTo = UserDoc.FullUserName

MailDoc.Subject = Subject

Set RTItem = MailDoc.CreateRichTextItem("Body")
Call RTItem.AppendText(Remark)
Call RTItem.AddNewLine(1)
Call RTItem.AppendText("Document Link Icon -->")
Call RTItem.AppendDocLink(IncludeDoc, Subject)

 '=======測試用(Begin)=========
If DB.Server = "CN=CMOS051/O=CHIPMOS" Then
Call rtItem.AddNewLine(2) 
Call rtItem.AppendText("測試用 - Mail不直接寄送簽核者, 下列為實際收件者的名單" )
Call rtItem.AddNewLine(1) 
Call rtItem.AppendText("SendTo List : " )
If mailDoc.hasitem("SendTo") Then
Set itemSendTo = maildoc.GetFirstItem( "SendTo" )
Forall v In itemSendTo.Values
Call rtItem.AppendText( v)
Call rtItem.AppendText( " , ")
End Forall
End If 

Call rtItem.AddNewLine(2) 
Call rtItem.AppendText("CopyTo List : " )
If mailDoc.hasitem("CopyTo") Then
Set itemSendTo = maildoc.GetFirstItem( "CopyTo" )
Forall v In itemSendTo.Values
Call rtItem.AppendText( v)
Call rtItem.AppendText( " , ")
End Forall
End If

mailDoc.SendTo = jmcsession.UserName
mailDoc.CopyTo=""
mailDoc.BlindCopyTo = ""
End If
 '=======測試用(End)=========  
Call MailDoc.Send(False)

If PromptMessage Then
Print  "The '" + Subject + "' is mailed to " + Cstr(UserDoc.UserNameList(0))
End If

TheEnd:
Exit Sub
ErrorHandler:
Print "lib: JWFSFlowLibrary: MailSend error line = " + Cstr(Erl) + ", error = " + Error$
Resume TheEnd
End Sub