[AP] 報表內容直接列在mail裡送出

'//報表內容直接列在mail裡

[Options]
Option Public
Option Declare
Use "SP.wfLibV2"
Use "AgnesLibrary"

Use "DeputyLibrary"

[Declarations]

Dim richStyle As NotesRichTextStyle

Dim rtpStyle As  NotesRichTextParagraphStyle

Dim Memodoc As NotesDocument

Dim RTItem As NotesRichTextItem

Dim rowCnt As Integer

Function SP_PreparingAlart() As Integer
'//針對自CIMES自動轉入開立暫存的文件做稽催通知
'//send to: 開單人員的部門別
'//bcc: data owner
On Error Goto errorhandler
Call jmcf_blnSetNewVars()
Dim SourceDB As NotesDatabase, SourceDoc As NotesDocument
Dim setupdoc As NotesDocument
Dim alertvi As NotesView, alertdoc As NotesDocument, alertcol As NotesDocumentCollection
Dim alerttmp As NotesDocument
Dim vDeptNo As Variant, alertViName As String, varCurrSignerInfo As Variant
Dim SendTo As Variant, CopyTo As Variant, BlindCopyTo As Variant
Dim itemSendTo As NotesItem
'
Set SourceDB = jmcdb
Set SourceDoc = jmcdoc_Source
alertViName = "IP_1_5_9"
Set alertvi = SourceDB.GetView(alertViName)
If alertvi Is Nothing Then Print "not found vi: " + alertViName + " !!" : Exit Function

Set richStyle = jmcSession.CreateRichTextStyle
Set rtpStyle = jmcSession.CreateRichTextParagraphStyle
'rtpStyle.Alignment = ALIGN_NOWRAP

Set setupdoc = GetSystemDocument("Form-SystemSetup")   '//currentDB的系統設定檔
If setupdoc Is Nothing Then Print "not found doc: SystemSetup!!" : Exit Function



vDeptNo = Evaluate( "@dbcolumn("""";@dbname;""IP_1_5_9"";1)" ) '//依SignStatus = status1的部門群組

Forall DP In vDeptNo
Set alertcol = alertvi.GetAllDocumentsByKey(DP, True)
If alertcol.Count = 0 Then Goto NextDeptNo
Set alertdoc = alertcol.GetFirstDocument()
varCurrSignerInfo = GetEmpInfo(alertdoc.EmpNo(0))   '//依點將錄找到開單者資料
'
'//Mail subject
Set memoDoc = New NotesDocument(jmcdb)
memodoc.Form = "Memo"
memodoc.Principal = jmcdb.Title
memodoc.Subject = SourceDB.Title + "_IP" + " 請幹部確認異常項目"
SendTo = DP   '//部門群組
CopyTo = ""
BlindCopyTo = setupdoc.USEREmpEName2(0)  '//data owner
BlindCopyTo = SP_aryAddItem(BlindCopyTo, setupdoc.ItmEmpEName(0))

'//建立內容的字型
Set RTItem = MemoDoc.CreateRichTextItem("Body")
richStyle.FontSize = 10
richStyle.NotesFont = RTItem.GetNotesFont("Arial", True)
Call RTItem.AppendStyle(richStyle)
Call RTItem.AppendParagraphStyle(rtpStyle)

'//mail header
richStyle.NotesColor = COLOR_BLACK
Call RTItem.AppendStyle(richStyle)
Call RTItem.AppendText("自CIMES轉入開立暫存文件：")
Call RTItem.AddNewLine(2,True)
'Dept No | Lot No.|  Customer | PKG_Type
Call rtitem.AddTab(1)
Call rtitem.AppendText( Leftbp$("Dept No." + Space$(30), 30))
Call rtitem.AddTab(1)
Call rtitem.AppendText(Leftbp$("Lot No." + Space$(30), 30))
Call rtitem.AddTab(2)
Call rtitem.AppendText(Leftbp$("Customer" + Space$(30), 30))
'Call rtitem.AddTab(1)
Call rtitem.AppendText(Leftbp$("PKG_Type" + Space$(30), 30))

Call RTItem.AddNewLine(1,True)
'//mail body
rowCnt = 0
Do While Not alertdoc Is Nothing
Set alerttmp = alertcol.GetNextDocument(alertdoc)
Call SP_getContent(alertdoc, Cstr(DP))
Set alertdoc = alerttmp
Loop

NextDeptNo:
End Forall

'//send mail
If Isarray(sendto) Then
Call memoDoc.ReplaceItemValue("SendTo", Arrayunique(sendto))
Else
Call memoDoc.ReplaceItemValue("SendTo", sendto)
End If
If Isarray(copyto) Then
Call memoDoc.ReplaceItemValue("CopyTo", Arrayunique(copyto))
Else
Call memoDoc.ReplaceItemValue("CopyTo", (copyto))
End If
If Isarray(BlindCopyTo) Then
Call memoDoc.ReplaceItemValue("BlindCopyTo", Arrayunique(BlindCopyTo))
Else
Call memoDoc.ReplaceItemValue("BlindCopyTo", BlindCopyTo)
End If

'=======測試用(Begin)=========
'%REM
If SourceDB.Server = "CN=CMOS051/O=CHIPMOS" Or _
SourceDB.Server = "CN=NOTESLAB/O=THAILIN" Or _
SourceDB.Server = "CN=TR02/O=CMOSSH"  Then
Call rtItem.AddNewLine(2)
Call rtItem.AppendText("測試用 - Mail不直接寄送簽核者, 下列為實際收件者的名單" )
Call rtItem.AddNewLine(1)
Call rtItem.AppendText("SendTo List : " )
If memoDoc.hasitem("SendTo") Then
Set itemSendTo = memodoc.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 memoDoc.hasitem("CopyTo") Then
Set itemSendTo = memodoc.GetFirstItem( "CopyTo" )
Forall v In itemSendTo.Values
Call rtItem.AppendText( v)
Call rtItem.AppendText( " , ")
End Forall
End If

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

memoDoc.SendTo = jmcSession.UserName
memoDoc.CopyTo=""
memoDoc.BlindCopyTo = ""
End If
     '=======測試用(End)=========
'%END REM
If memoDoc.SendTo(0) <> "" Then
Call memoDoc.Send(False)
End If



TheEnd:
Exit Function
ErrorHandler:
Print "Lib: SP.RunScheduleAgents: SP_PreparingAlart() error line = " + Cstr(Erl) + ", error = " + Error$
Dim strSubject As String, strBody As String
strSubject = " (Library Error) : " + SourceDB.Title + "(" + SourceDB.FilePath + ")  error line = " + Cstr(Erl) + ", Error = " +  Error$
Print strSubject
strBody = ""
Call MailSend(setupdoc.ItmEmpNo, "", strSubject, strBody, alertdoc, False)
'Goto NextAlertDoc
Resume TheEnd

End Function
'
'
'
Function SP_getContent(pdoc As NotesDocument, sDeptNo As String) As Integer
'//鉏成mail content
On Error Goto errorhandler
Call jmcf_blnSetNewVars()

'Mail Body
Dim i As Integer
Dim strCust As String

richStyle.NotesColor = COLOR_BLACK
Call RTItem.AppendStyle(richStyle)

'Dept No | Lot No.|  Customer | PKG_Type
'//Item
rowCnt = rowCnt + 1
Call RTItem.AppendText( Format( rowCnt ,"!@@@@") & Space(1))

Call rtitem.AppendDocLink(pdoc, "")
Call rtitem.AppendText(Space$(2))
'Call rtitem.AppendDocLink(jmcdb, "")
'Call rtitem.AddTab(1)

'//Dept No.
Call rtitem.AppendText( Leftbp$(sDeptNo + Space$(30), 30) )
Call rtitem.AddTab(1)

'//Lot No.
Call rtitem.AppendText( Leftbp$(pdoc.LotNo(0) + Space$(30), 30) )
Call rtitem.AddTab(1)

'//Customer
strCust = pdoc.Cus(0) + " / " + pdoc.Cus_1(0)
Call rtitem.AppendText( Leftbp$(strCust + Space$(30), 30) )
'Call rtitem.AddTab(1)

'//PKG_Type
Call rtitem.AppendText( Leftbp$(pdoc.PKG_Type(0) + Space$(30), 30) )
Call RTItem.AddNewLine(1,True)


TheEnd:
Exit Function
ErrorHandler:
Print "lib: " +  + ": SP_getContent error line = " + Cstr(Erl) + ", error = " + Error$
Resume TheEnd

End Function
'
'
'
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" Or _
DB.Server = "CN=NOTESLAB/O=THAILIN" Or _
DB.Server = "CN=TR02/O=CMOSSH"  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 "ag: R1. Daily Reminder (Normal): MailSend error line = " + Cstr(Erl) + ", error = " + Error$
Resume TheEnd

End Sub