使用MIME控制电子邮件中的HTML和附件的顺序

Question

我的数据库有一些Notes文档是电子邮件模板。他们有一个名字，一个附件字段和一个html字段。

我试图编写一个代理，可以抓住这个文件，并构建一个内部电子邮件，将有HTML和附件。

我的代码工作，但邮件是这样的：

我不想附着在最顶端。我宁愿将它嵌入到HTML中。当我抓取html文本时，我会替换一些值，比如用户的名字，这样邮件就可以是动态的。我只是把“| REPLACE1 |”我希望用户的名字被放入。有没有办法用“| FILEREPLACE1 |”编写html这样我就可以动态地附加文件了？

如果不是，我可以把附件放在电子邮件底部吗？

LS级 “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 

Answer 1

我爱的电子邮件类！伟大的概念。我希望它为你工作。

我没有答案，但我可能有一个解决方案？如果可以的话，我强烈建议你改变你的电子邮件地址，以便代替附件你有一个集中存储的链接！如果您正如所说的那样，为什么要创建重复邮件呢？

您可以链接到/DatabasePath/xpViewEmailsAll/$First/$File/To%20Terminate%20an%20Employee%20(manager).pdf，但我建议您改为链接到/ Database/AttachmentRequests/To％ 20Terminate％20an％20Employee％20（manager）.pdf其中“AttachmentRequests”是一个带有表单公式的视图，第一个排序列包含提供的每个文件的名称，而指定表单则拦截打开并启动附件本身。这样它可以适用于Notes或Web客户端，并且当需要在一些可预见的混乱的将来出现时，您将能够改变行为而不是报告“THIS HAS MOVED”，或者可能将它们转发到正确的页面上到内部网站。