使用 MIME 控制 HTML 和电子邮件附件的顺序
Controlling order of HTML and Attachments on email using MIME
我的数据库有一些 Notes 文档，它们是电子邮件模板。它们有一个名称、一个附件字段和 html 字段。
我正在尝试编写一个可以获取此文档并构建包含 html 和附件的内部电子邮件的代理程序。
我的代码有效，但电子邮件如下所示：
我不想把附件放在最上面。我更愿意将它嵌入 html。当我抓取 html 文本时，我替换了一些值，例如用户名，因此电子邮件可以是动态的。我只是把“|REPLACE1|”我希望将用户名放入其中。有没有办法用“|FILEREPLACE1|”编写 html这样我就可以动态附加文件了？
如果不行，我可以把附件放在邮件底部吗？
LS Class "ClsEmail"
%REM
Library ClsEmail
Created Dec 4, 2016 by Bryan Schmiedeler/Scoular
Description: Comments for Library
%END REM
Option Public
Option Declare
Const ERR_EMAIL_MODIFICATION_NOT_ALLOWED = "You can not make changes to an email once it has been sent."
Dim emlView As NotesView
Dim emlDoc As NotesDocument
Dim object As NotesEmbeddedObject
Dim docUNID As String
Dim fleNme As String
Dim bodyChild As NotesMIMEEntity
Dim hdr As NotesMIMEHeader
Dim Success As Boolean
Class Email
Private session As NotesSession
Private doc As NotesDocument
Private body As NotesMIMEEntity
Private mh As NotesMIMEHeader
Private mc As NotesMIMEEntity
Private ma As NotesMIMEEntity
Private stream As NotesStream
Private isTextSet As Boolean
Private isHTMLSet As Boolean
Private isStyleSet As Boolean
Private isRebuildNeeded As Boolean
Private isMailBuilt As Boolean
Private rtitem As NotesRichTextItem
Private str_TextPart As String
Private str_HTMLPart As String
Private str_DefaultStyles As String
Private str_Styles As String
Private FromName(0 To 2) As String
Sub New()
Set Me.session = New NotesSession()
'Set Me.elmTrmDoc = nothing
'Set me.unid = ""
Set Me.doc = Me.session.Currentdatabase.CreateDocument
Me.doc.Form = "Memo"
Me.FromName(0) = "Sender's Name"
Me.FromName(1) = "foo@bar.net"
Me.FromName(2) = "DOMAIN"
Me.str_DefaultStyles = "body{margin:10px;font-family:verdana,arial,helvetica,sans-serif;}"
Me.isTextSet = False
Me.isHTMLSet = False
Me.isRebuildNeeded = True
Me.isMailBuilt = False
End Sub
Property Set Subject As String
Me.doc.subject = subject
End Property
Property Set unid As String
Me.unid = unid
End Property
Property Set Plain
Me.str_TextPart = Plain
Me.isTextSet = True
Me.isRebuildNeeded = True
End Property
Property Get Plain
Plain = Me.str_TextPart
End Property
Property Set HTML
Me.str_HTMLPart = HTML
Me.isHTMLSet = True
Me.isRebuildNeeded = True
End Property
Property Get HTML
HTML = Me.str_HTMLPart
End Property
Property Set Styles As String
Me.str_Styles = Styles
Me.isStyleSet = True
Me.isRebuildNeeded = True
End Property
Property Set CSS As String
Me.Styles = CSS
End Property
Property Set Sender As Variant
Me.FromName(0) = Sender(0)
Me.FromName(1) = Sender(1)
Me.FromName(2) = Sender(2)
Me.isRebuildNeeded = True
End Property
Property Set ReplyTo As String
Me.Doc.ReplyTo = ReplyTo
Me.isRebuildNeeded = True
End Property
Property Set CopyTo As String
Me.Doc.CopyTo = CopyTo
Me.isRebuildNeeded = True
End Property
Property Set BlindCopyTo As String
Me.Doc.BlindCopyTo = BlindCopyTo
Me.isRebuildNeeded = True
End Property
Sub Rebuild
If Me.doc.HasItem("Body") Then
Call Me.doc.RemoveItem("Body")
End If
If Me.isHTMLSet Then 'Send mulipart/alternative
'Create the MIME headers
Me.session.convertMIME = False
Set Me.body = Me.doc.CreateMIMEEntity("Body")
Set Me.mh = Me.body.CreateHeader({MIME-Version})
Call Me.mh.SetHeaderVal("1.0")
Set Me.mh = Me.body.CreateHeader("Content-Type")
Call Me.mh.SetHeaderValAndParams( {multipart/alternative;boundary="=NextPart_="})
'Now send the HTML part. Order is important!
Set Me.mc = Me.body.createChildEntity()
Set Me.stream = Me.session.createStream()
Set Me.mc = Me.body.createChildEntity()
' Call stream.WriteText(Replace(Me.str_HTMLPart, ">", ">"+Chr(10)))
Call stream.WriteText(Me.str_HTMLPart)
'Extract Attachment and add to this email
Set emlView = Me.session.Currentdatabase.Getview("xpViewEmailsAll")
Set emlDoc = emlView.getFirstDocument
Dim obj As NotesEmbeddedObject
Set obj = emlDoc.GetAttachment("To Terminate an Employee (manager).pdf")
fleNme = "c:/temp/" + obj.Name()
Call obj.ExtractFile(fleNme)
Set bodyChild = Me.body.Createchildentity()
Success = MimeAttachFileAsBase64(bodyChild,"c:/temp/",obj.Name())
'Remove File
'Kill fleNme
Call Me.mc.setContentFromText(Me.stream, {text/html;charset="iso-8859-1"}, ENC_NONE)
Call Me.doc.Closemimeentities(True)
Me.session.convertMIME = True
End If
Me.doc.Principal= Me.FromName(0) +" <"+Me.FromName(1)+"@"+Me.FromName(2)+">"
Me.doc.InetFrom = Me.FromName(0) +" <"+Me.FromName(1)+">"
Me.isMailBuilt = True
Me.isRebuildNeeded = False
End Sub
Sub Send(sendTo As String)
If Me.isMailBuilt And Me.isRebuildNeeded Then
Error 1000, ERR_EMAIL_MODIFICATION_NOT_ALLOWED
ElseIf Not Me.isMailBuilt Then
Call Me.Rebuild()
End If
Me.Doc.SendTo = SendTo
Call Me.Doc.Send(False)
End Sub
End Class
Function MimeAttachFileAsBase64(mime As NotesMIMEEntity, sFolderPath As String, sFileName As String) As Boolean
On Error GoTo ERRHANDLER
Dim sess As New NotesSession
Dim nsFile As NotesStream
Dim bodyChild As NotesMIMEEntity
Dim header As NotesMIMEHeader
Dim sContentType As String
Dim MimeAttachFile As Boolean
MimeAttachFile = False
Set nsFile = sess.CreateStream()
If Not nsFile.Open(sFolderPath & sFileName, "Binary") Then
Print "MimeAttachFileAsBase64 Error: Failed to open file: " & sFolderPath & sFileName
Err = 0
Exit Function
End If
Set bodyChild = mime.CreateChildEntity()
sContentType = |application/octet-stream|
Call bodyChild.SetContentFromBytes (nsFile,sContentType & |; name="| & sFileName & |"|, ENC_NONE)
Call bodyChild.EncodeContent(ENC_BASE64)
Set header = bodyChild.createHeader("Content-Disposition")
Call header.SetHeaderVal(|attachment; filename="| & sFileName & |"|)
Call nsFile.Close()
Set nsFile = Nothing
MimeAttachFile = True
Exit Function
ERRHANDLER:
Print "MimeAttachFileAsBase64 Error: " & Format$(Err) & " " & Error & " # Line: " & Format$(Erl)
Err = 0
Exit Function
End Function
代理代码：
Sub Initialize
Dim session As New NotesSession
Dim doc As NotesDocument
Dim db As NotesDatabase
Dim emlView As NotesView
Dim emlDoc As NotesDocument
Dim rti As NotesRichTextItem
Dim unfTxt As String
Dim unfTxt2 As String
Dim empNme As String
Dim docUNID As String
Set db = session.CurrentDatabase
Dim agent As NotesAgent
Set agent=session.Currentagent
'Get a handle On term
Set doc = db.GetDocumentByUnid("D321286EADF83DA78625807C006A7A84")
'Set doc = db.GetDocumentByID(agent.ParameterDocID)
'Get a handle on HTML Doc
Set emlView = db.Getview("xpViewEmailsAll")
Set emlDoc = emlView.getFirstDocument
unfTxt = emlDoc.emlBdyTxt(0)
empNme = doc.EmployeeName(0)
docUNID = emlDoc.Universalid
'Run REPLACE1
unfTxt2 = ReplaceSubstring(unfTxt,"|REPLACE1|",empNme)
Dim mail As New Email()
mail.Subject = "Termination Notification for " + empNme
mail.HTML = unfTxt2
mail.CSS = "p{margin:2em}"
mail.Sender = Split("IT Help Desk,ithelpdesk@scoular.com,Scoular", ",")
mail.unid = docUNID
mail.Send("bschmiedeler@scoular.com")
End Sub
我喜欢那封电子邮件 class！伟大的概念。我希望它对你有用。
我没有答案，但我可能有解决方案？如果可以，我强烈建议您更改您的电子邮件，这样您就可以使用 link 集中存储附件，而不是附件！如果正如您所说，它是内部电子邮件，为什么要创建重复项？
你可以 link 到 /DatabasePath/xpViewEmailsAll/$First/$File/To%20Terminate%20an%20Employee%20(manager).pdf 但我建议你改为 link 到 /Database/AttachmentRequests/To%20Terminate%20an%20Employee%20(manager).pdf 其中 "AttachmentRequests" 是带有表单公式的视图，第一个排序列包含提供的每个文件的名称，并且指定的表单拦截打开并启动附件本身。这样它就可以用于 Notes 或 Web 客户端，并且当在一些可预测的混乱未来出现需要时，您将能够更改行为以代替报告 "THIS HAS MOVED" 或可能将它们转发到某些尚未上的正确页面- 现有的内部网站。
我的数据库有一些 Notes 文档，它们是电子邮件模板。它们有一个名称、一个附件字段和 html 字段。
我正在尝试编写一个可以获取此文档并构建包含 html 和附件的内部电子邮件的代理程序。
我的代码有效，但电子邮件如下所示：
我不想把附件放在最上面。我更愿意将它嵌入 html。当我抓取 html 文本时，我替换了一些值，例如用户名，因此电子邮件可以是动态的。我只是把“|REPLACE1|”我希望将用户名放入其中。有没有办法用“|FILEREPLACE1|”编写 html这样我就可以动态附加文件了？
如果不行，我可以把附件放在邮件底部吗？
LS Class "ClsEmail"
%REM
Library ClsEmail
Created Dec 4, 2016 by Bryan Schmiedeler/Scoular
Description: Comments for Library
%END REM
Option Public
Option Declare
Const ERR_EMAIL_MODIFICATION_NOT_ALLOWED = "You can not make changes to an email once it has been sent."
Dim emlView As NotesView
Dim emlDoc As NotesDocument
Dim object As NotesEmbeddedObject
Dim docUNID As String
Dim fleNme As String
Dim bodyChild As NotesMIMEEntity
Dim hdr As NotesMIMEHeader
Dim Success As Boolean
Class Email
Private session As NotesSession
Private doc As NotesDocument
Private body As NotesMIMEEntity
Private mh As NotesMIMEHeader
Private mc As NotesMIMEEntity
Private ma As NotesMIMEEntity
Private stream As NotesStream
Private isTextSet As Boolean
Private isHTMLSet As Boolean
Private isStyleSet As Boolean
Private isRebuildNeeded As Boolean
Private isMailBuilt As Boolean
Private rtitem As NotesRichTextItem
Private str_TextPart As String
Private str_HTMLPart As String
Private str_DefaultStyles As String
Private str_Styles As String
Private FromName(0 To 2) As String
Sub New()
Set Me.session = New NotesSession()
'Set Me.elmTrmDoc = nothing
'Set me.unid = ""
Set Me.doc = Me.session.Currentdatabase.CreateDocument
Me.doc.Form = "Memo"
Me.FromName(0) = "Sender's Name"
Me.FromName(1) = "foo@bar.net"
Me.FromName(2) = "DOMAIN"
Me.str_DefaultStyles = "body{margin:10px;font-family:verdana,arial,helvetica,sans-serif;}"
Me.isTextSet = False
Me.isHTMLSet = False
Me.isRebuildNeeded = True
Me.isMailBuilt = False
End Sub
Property Set Subject As String
Me.doc.subject = subject
End Property
Property Set unid As String
Me.unid = unid
End Property
Property Set Plain
Me.str_TextPart = Plain
Me.isTextSet = True
Me.isRebuildNeeded = True
End Property
Property Get Plain
Plain = Me.str_TextPart
End Property
Property Set HTML
Me.str_HTMLPart = HTML
Me.isHTMLSet = True
Me.isRebuildNeeded = True
End Property
Property Get HTML
HTML = Me.str_HTMLPart
End Property
Property Set Styles As String
Me.str_Styles = Styles
Me.isStyleSet = True
Me.isRebuildNeeded = True
End Property
Property Set CSS As String
Me.Styles = CSS
End Property
Property Set Sender As Variant
Me.FromName(0) = Sender(0)
Me.FromName(1) = Sender(1)
Me.FromName(2) = Sender(2)
Me.isRebuildNeeded = True
End Property
Property Set ReplyTo As String
Me.Doc.ReplyTo = ReplyTo
Me.isRebuildNeeded = True
End Property
Property Set CopyTo As String
Me.Doc.CopyTo = CopyTo
Me.isRebuildNeeded = True
End Property
Property Set BlindCopyTo As String
Me.Doc.BlindCopyTo = BlindCopyTo
Me.isRebuildNeeded = True
End Property
Sub Rebuild
If Me.doc.HasItem("Body") Then
Call Me.doc.RemoveItem("Body")
End If
If Me.isHTMLSet Then 'Send mulipart/alternative
'Create the MIME headers
Me.session.convertMIME = False
Set Me.body = Me.doc.CreateMIMEEntity("Body")
Set Me.mh = Me.body.CreateHeader({MIME-Version})
Call Me.mh.SetHeaderVal("1.0")
Set Me.mh = Me.body.CreateHeader("Content-Type")
Call Me.mh.SetHeaderValAndParams( {multipart/alternative;boundary="=NextPart_="})
'Now send the HTML part. Order is important!
Set Me.mc = Me.body.createChildEntity()
Set Me.stream = Me.session.createStream()
Set Me.mc = Me.body.createChildEntity()
' Call stream.WriteText(Replace(Me.str_HTMLPart, ">", ">"+Chr(10)))
Call stream.WriteText(Me.str_HTMLPart)
'Extract Attachment and add to this email
Set emlView = Me.session.Currentdatabase.Getview("xpViewEmailsAll")
Set emlDoc = emlView.getFirstDocument
Dim obj As NotesEmbeddedObject
Set obj = emlDoc.GetAttachment("To Terminate an Employee (manager).pdf")
fleNme = "c:/temp/" + obj.Name()
Call obj.ExtractFile(fleNme)
Set bodyChild = Me.body.Createchildentity()
Success = MimeAttachFileAsBase64(bodyChild,"c:/temp/",obj.Name())
'Remove File
'Kill fleNme
Call Me.mc.setContentFromText(Me.stream, {text/html;charset="iso-8859-1"}, ENC_NONE)
Call Me.doc.Closemimeentities(True)
Me.session.convertMIME = True
End If
Me.doc.Principal= Me.FromName(0) +" <"+Me.FromName(1)+"@"+Me.FromName(2)+">"
Me.doc.InetFrom = Me.FromName(0) +" <"+Me.FromName(1)+">"
Me.isMailBuilt = True
Me.isRebuildNeeded = False
End Sub
Sub Send(sendTo As String)
If Me.isMailBuilt And Me.isRebuildNeeded Then
Error 1000, ERR_EMAIL_MODIFICATION_NOT_ALLOWED
ElseIf Not Me.isMailBuilt Then
Call Me.Rebuild()
End If
Me.Doc.SendTo = SendTo
Call Me.Doc.Send(False)
End Sub
End Class
Function MimeAttachFileAsBase64(mime As NotesMIMEEntity, sFolderPath As String, sFileName As String) As Boolean
On Error GoTo ERRHANDLER
Dim sess As New NotesSession
Dim nsFile As NotesStream
Dim bodyChild As NotesMIMEEntity
Dim header As NotesMIMEHeader
Dim sContentType As String
Dim MimeAttachFile As Boolean
MimeAttachFile = False
Set nsFile = sess.CreateStream()
If Not nsFile.Open(sFolderPath & sFileName, "Binary") Then
Print "MimeAttachFileAsBase64 Error: Failed to open file: " & sFolderPath & sFileName
Err = 0
Exit Function
End If
Set bodyChild = mime.CreateChildEntity()
sContentType = |application/octet-stream|
Call bodyChild.SetContentFromBytes (nsFile,sContentType & |; name="| & sFileName & |"|, ENC_NONE)
Call bodyChild.EncodeContent(ENC_BASE64)
Set header = bodyChild.createHeader("Content-Disposition")
Call header.SetHeaderVal(|attachment; filename="| & sFileName & |"|)
Call nsFile.Close()
Set nsFile = Nothing
MimeAttachFile = True
Exit Function
ERRHANDLER:
Print "MimeAttachFileAsBase64 Error: " & Format$(Err) & " " & Error & " # Line: " & Format$(Erl)
Err = 0
Exit Function
End Function
代理代码：
Sub Initialize
Dim session As New NotesSession
Dim doc As NotesDocument
Dim db As NotesDatabase
Dim emlView As NotesView
Dim emlDoc As NotesDocument
Dim rti As NotesRichTextItem
Dim unfTxt As String
Dim unfTxt2 As String
Dim empNme As String
Dim docUNID As String
Set db = session.CurrentDatabase
Dim agent As NotesAgent
Set agent=session.Currentagent
'Get a handle On term
Set doc = db.GetDocumentByUnid("D321286EADF83DA78625807C006A7A84")
'Set doc = db.GetDocumentByID(agent.ParameterDocID)
'Get a handle on HTML Doc
Set emlView = db.Getview("xpViewEmailsAll")
Set emlDoc = emlView.getFirstDocument
unfTxt = emlDoc.emlBdyTxt(0)
empNme = doc.EmployeeName(0)
docUNID = emlDoc.Universalid
'Run REPLACE1
unfTxt2 = ReplaceSubstring(unfTxt,"|REPLACE1|",empNme)
Dim mail As New Email()
mail.Subject = "Termination Notification for " + empNme
mail.HTML = unfTxt2
mail.CSS = "p{margin:2em}"
mail.Sender = Split("IT Help Desk,ithelpdesk@scoular.com,Scoular", ",")
mail.unid = docUNID
mail.Send("bschmiedeler@scoular.com")
End Sub
我喜欢那封电子邮件 class！伟大的概念。我希望它对你有用。
我没有答案，但我可能有解决方案？如果可以，我强烈建议您更改您的电子邮件，这样您就可以使用 link 集中存储附件，而不是附件！如果正如您所说，它是内部电子邮件，为什么要创建重复项？
你可以 link 到 /DatabasePath/xpViewEmailsAll/$First/$File/To%20Terminate%20an%20Employee%20(manager).pdf 但我建议你改为 link 到 /Database/AttachmentRequests/To%20Terminate%20an%20Employee%20(manager).pdf 其中 "AttachmentRequests" 是带有表单公式的视图，第一个排序列包含提供的每个文件的名称，并且指定的表单拦截打开并启动附件本身。这样它就可以用于 Notes 或 Web 客户端，并且当在一些可预测的混乱未来出现需要时，您将能够更改行为以代替报告 "THIS HAS MOVED" 或可能将它们转发到某些尚未上的正确页面- 现有的内部网站。