LotusScript 发送HTML格式邮件(Outlook)2

 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

 

你可能感兴趣的:(script)