1 Sub Initialize 2 Msgbox "h3c18001:SendTaskMail Start" 3 On Error Goto errormsg 4 Dim fldlst As New LCFieldList 5 Dim doc As NotesDocument 6 Dim sql As String, DocUrl As String, MainDocUNID As String, DocUNID As String 7 Dim Subject As String,HtmlBody As String 8 MainDocUNID = WF_Document.WF_DocUNID(0) 9 DocUrl = GetConfigById("HttpServer") 10 sql = |select * from bpm_dicdoclist where AppId='h3c18001' And FolderId='011' And XmlData.value('(/Items/WFItem[@name="MainDocID"])[1]','nvarchar(max)')='|+MainDocUNID+|'| 11 msgbox sql 12 Call WF_Con.execute(sql,fldlst) 13 While WF_Con.fetch(fldlst) 14 Set doc = rdb.getTmpDoc(fldlst) 15 DocUNID = doc.WF_DocUNID(0) 16 SendTo = doc.implementer(0) 17 Subject = doc.Subject(0) 18 HtmlBody = |请及时完成任务单的交办任务<BR>| 19 HtmlBody = HtmlBody + |请点击链接打开文档：<a href="|+DocUrl+|/bpm/app.nsf/frmOpenForm?readform&WF_FormNumber=F_h3c18001_011.1&WF_DocUNID=|+DocUNID+|&WF_Action=Edit" target="_blank">打开文档</a><BR><BR>| 20 Call SendMail(doc,SendTo,"",Subject,HtmlBody,"") 21 Wend 22 Msgbox "h3c18001:SendTaskMail Start" 23 Exit Sub 24 errormsg: 25 Msgbox "Rule Error:" & Str(Erl) & " " & Error 26 End Sub 27 function SendMail(tmpdoc As NotesDocument,SendTo As Variant,CopyTo As Variant,Subject As String,HtmlBody As String,FromName As String) 28 '替换标题 29 dim i As integer,lStr As string,rStr As string,mStr As string,vStr As string,maxnum As integer 30 i=InStr(Subject,"{") 31 While i>0 And maxnum<20 32 maxnum=maxnum+1 33 lStr=StrLeft(Subject,"}") 34 mStr=StrRight(lStr,"{") 35 lStr=StrLeft(lStr,"{") 36 rStr=StrRight(Subject,"}") 37 vStr=ArrayToStr(tmpdoc.GetItemValue(mStr),",") 38 Subject=lStr+vStr+rStr 39 i=InStr(rStr,"{") 40 Wend 41 '替换内容 42 Dim HttpServer As String,Folder as string,DocUrl as string 43 Folder=StrLeftBack(Replace(tmpdoc.parentdatabase.filepath,"/",""),"") 44 HttpServer=GetConfigById("HttpServer") 45 DocUrl=HttpServer+"/"+Folder+"/frmOpenForm?readform&WF_FormNumber="+tmpdoc.WF_FormNumber(0)+"&WF_DocUNID="+tmpdoc.WF_DocUNID(0) 46 HtmlBody=Replace(HtmlBody,"{doclink}","<a href='"+DocUrl+"' target='_blank' >"+tmpdoc.Subject(0)+"</a>") 47 HtmlBody=Replace(HtmlBody,"{systemlink}","<a href='"+GetConfigById("System_Url")+"' target='_blank' >"+GetConfigById("System_Name")+"</a>") 48 HtmlBody=Replace(HtmlBody,Chr(13)&Chr(10),"<br>") 49 maxnum=0 50 i=InStr(HtmlBody,"{") 51 While i>0 And maxnum<20 52 lStr=StrLeft(HtmlBody,"}") 53 mStr=StrRight(lStr,"{") 54 lStr=StrLeft(lStr,"{") 55 rStr=StrRight(HtmlBody,"}") 56 vStr=ArrayToStr(tmpdoc.GetItemValue(mStr),",") 57 HtmlBody=lStr+vStr+rStr 58 i=InStr(rStr,"{") 59 Wend 60 '内容替换结束 61 Dim s as new NotesSession 62 dim db as notesdatabase 63 dim doc as notesdocument 64 dim body as NotesMIMEEntity 65 dim header as NotesMIMEHeader 66 dim stream as NotesStream 67 set db = s.CurrentDatabase 68 set stream = s.CreateStream 69 s.ConvertMIME= False' do not convert MIME to rich text 70 set doc = db.CreateDocument 71 doc.Form = "Memo" 72 doc.SendTo=SendTo 73 doc.CopyTo=CopyTo 74 doc.Subject=Subject 75 doc.Principal=FormName 76 doc.InetForm=FormName 77 doc.TMPDISPLAYFORM_PREVIEW=FormName 78 doc.TMPDISPLAYFORM_NOLOGO=FormName 79 set body = doc.CreateMIMEEntity 80 set header = body.CreateHeader({MIME-Version}) 81 call header.SetHeaderVal("1.0") 82 set header = body.CreateHeader("Content-Type") 83 call header.SetHeaderValAndParams({multipart/alternative;boundary="=NextPart_="}) 84 call stream.writetext(|<HTML>|) 85 call stream.writetext(|<body bgcolor="white">|) 86 call stream.writetext(|<font size="2">|) 87 call stream.writetext(HtmlBody) 88 call stream.writetext(|</font>|) 89 call stream.writetext(|</body>|) 90 call stream.writetext(|</HTML>|) 91 body.SetContentFromText stream,"text/html;charset=UTF-8",ENC_NONE 92 call doc.Send(False) 93 s.ConvertMIME = True 'Restore conversion - very important 94 95 end function