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

  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

 

你可能感兴趣的:(script)