1 Sub Initialize 2 On Error Goto errormsg 3 Msgbox "RUh3c18001_011:SendMailOfReview Start" 4 Dim sql As String 5 Dim doc As NotesDocument 6 Dim docunid As Variant 7 Dim i As Integer, n As Integer 8 Dim tr As String, table As String, HTMLBody As String, mailsend As String 9 Dim ProcessUNID As String 10 ProcessUNID = "B994EBB76C5F586648257DC4002AB3BB" 11 docunid = Split(WF_Document.docunid(0), ",") 12 n = Ubound(docunid) 13 mailsend = GetSendTo 14 msgbox mailsend 15 If mailsend = "" Then 16 Print "Context-Type:application/text;charset=UTF-8" 17 Print "没有找到邮件接收人,请检查配置文档！" 18 Exit Sub 19 End If 20 table = "<Table style='BORDER-COLLAPSE: collapse' border=1>" 21 table = table + InitTable 22 For i = 0 To n 23 sql = |select * from BPM_DicDocList where WF_DocUNID = '|+docunid(i)+|'| 24 Set doc = rdb.GetDocumentBySql(sql) 25 If Not doc Is Nothing Then 26 table = table + InitTR(doc, ProcessUNID) 27 End If 28 Next 29 table = table + "</Table>" 30 HTMLBody = "1、变更评审清单：<BR>" + table 31 HTMLBody = HTMLBody + "<BR><BR>2、如果您认为以上变更只需发起邮件评审，请在今天10：30前邮件反馈我，谢谢！" 32 SendTo = Split(mailsend, ",") 33 Call SendMail(SendTo, "变更申请", HTMLBody) 34 Msgbox "RUh3c18001_011:SendMailOfReview End" 35 Print "Context-Type:application/text;charset=UTF-8" 36 Print "OK" 37 Exit Sub 38 errormsg: 39 Msgbox "Rule Error:" & Str(Erl) & " " & Error 40 End Sub 41 Function GetSendTo() As String 42 Dim sql As String 43 Dim confdoc As NotesDocument 44 sql = |select top 1 * from BPM_DicDocList where AppId = 'h3c18001' and FolderId = '003'| 45 Set confdoc = rdb.GetDocumentBySql(sql) 46 If Not confdoc Is Nothing Then 47 GetSendTo = confdoc.meeting(0) 48 Else 49 GetSendTo = "" 50 End If 51 End Function 52 Function SendMail(SendTo As Variant,Subject As String,HTMLBody As String) 53 Dim se As New NotesSession 54 Dim db As NotesDatabase 55 Dim maildoc As NotesDocument 56 Dim body As NotesMIMEEntity 57 Dim header As NotesMIMEHeader 58 Dim stream As NotesStream 59 Set db = se.CurrentDatabase 60 Set stream = se.CreateStream 61 Set maildoc = db.CreateDocument 62 Maildoc.Form = "Memo" 63 Maildoc.Subject = Subject 64 Maildoc.SendTo = SendTo 65 Set body = Maildoc.CreateMIMEEntity 66 'Set header = body.CreateHeader("To") 67 'Call header.SetHeaderVal("guojian KF3530") 68 Call stream.writetext(|<HTML>|) 69 Call stream.writetext(|<body>|) 70 Call stream.writetext(HTMLBody) 71 Call stream.writetext(|</body>|) 72 Call stream.writetext(|</HTML>|) 73 Call body.SetContentFromText(stream,"text/HTML;charset=UTF-8",ENC_NONE) 74 Call maildoc.Send(False) 75 se.ConvertMIME = True 76 End Function 77 Function InitTable() As String 78 Dim table As String 79 table = "<TR>" 80 table = table + "<TD>电子流号</TD>" 81 table = table + "<TD>主题</TD>" 82 table = table + "<TD>状态</TD>" 83 table = table + "<TD>当前处理人</TD>" 84 table = table + "<TD>申请人</TD>" 85 table = table + "<TD>申请时间</TD>" 86 table = table + "</TR>" 87 InitTable = table 88 End Function 89 Function InitTR(doc As NotesDocument,ProcessUNID As String) As String 90 Dim HStr As String 91 Dim DocUrl As String, sql As String 92 Dim MainDoc As NotesDocument 93 Dim docStatus As String,curUser As String 94 DocUrl = GetConfigById("SendMailDocUrl") 95 DocUrl = Replace(DocUrl,"{ProcessUNID}",ProcessUNID) 96 DocUrl = Replace(DocUrl,"{DocUNID}",doc.MainDocId(0)) 97 docStatus = "" 98 curUser = "" 99 sql = |select top 1 * from BPM_AllDocument where WF_DocUNID = '| + doc.MainDocId(0) + |' | 100 Set MainDoc = rdb.GetDocumentBySql(sql) 101 If Not MainDoc Is Nothing Then 102 docStatus = MainDoc.WF_CurrentNodeName(0) 103 curUser = MainDoc.WF_Author(0) 104 End If 105 HStr = "<TR>" 106 HStr = HStr + "<TD>" + doc.DocNo(0) + "</TD>" 107 HStr = HStr + "<TD><a href='" + DocUrl + "'>" + doc.Subject(0) + "</a></TD>" 108 HStr = HStr + "<TD>" + docStatus + "</TD>" 109 HStr = HStr + "<TD>" + curUser + "</TD>" 110 HStr = HStr + "<TD>" + doc.applyer(0) + "</TD>" 111 HStr = HStr + "<TD>" + doc.applytime(0) + "</TD>" 112 HStr = HStr + "</TR>" 113 InitTR = HStr 114 End Function