使用Excel从Lotus Notes发送电子邮件并使用附件和HTML主体

Question

右键我试图通过Lotus Notes发送电子邮件格式的excel电子表格，它具有附件，并且身体需要使用HTML。

我有一些代码，从我读过的所有应该允许我这样做，但它没有。 没有HTML主体附件会发送，当我impliment一个HTML主体的电子邮件仍然发送但附件消失，我试着重新排列代码的顺序，删除可能不需要的位，但都是入侵的顺序。

（你需要参考的Lotus Domino对象来运行该代码。 strEmail是电子邮件地址 strAttach是附件 strSubject的字符串位置是主题文本 strBody是正文 ）

Sub Send_Lotus_Email(strEmail, strAttach, strSubject, strBody) 

Dim noSession As Object, noDatabase As Object, noDocument As Object 
Dim obAttachment As Object, EmbedObject As Object 

Const EMBED_ATTACHMENT As Long = 1454 

Set noSession = CreateObject("Notes.NotesSession") 
Set noDatabase = noSession.GETDATABASE("", "") 

'If Lotus Notes is not open then open the mail-part of it. 
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL 

'Create the e-mail and the attachment. 
Set noDocument = noDatabase.CreateDocument 
Set obAttachment = noDocument.CreateRichTextItem("strAttach") 
Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", strAttach) 

'Add values to the created e-mail main properties. 
With noDocument 
    .Form = "Memo" 
    .SendTo = strEmail 
    '.Body = strBody ' Where to send the body if HTML body isn't used. 
    .Subject = strSubject 
    .SaveMessageOnSend = True 
End With 

noSession.ConvertMIME = False 
Set Body = noDocument.CreateMIMEEntity("Body") ' MIMEEntity to support HTML 
Set stream = noSession.CreateStream 
Call stream.WriteText(strBody) ' Write the body text to the stream 
Call Body.SetContentFromText(stream, "text/html;charset=iso-8859-1", ENC_IDENTITY_8BIT) 
noSession.ConvertMIME = True 

'Send the e-mail. 
With noDocument 
    .PostedDate = Now() 
    .Send 0, strEmail 
End With 

'Release objects from the memory. 
Set EmbedObject = Nothing 
Set obAttachment = Nothing 
Set noDocument = Nothing 
Set noDatabase = Nothing 
Set noSession = Nothing 

End Sub

如果somone可以指向我正确的方向，我将不胜感激。

编辑： 我已经做了更多的调查，我发现一个奇怪的现象，如果我看发送的文件夹中的电子邮件都有回形针的图标有附件，即使您甚至进入电子邮件甚至在发送HTML的时候不显示附件。

Answer 1

我设法解决了我自己的问题。

以同样的方式在HTML中创建MIME条目和流，您需要对附件进行相同操作，还需要将它们放在电子邮件本身的MIME条目中，以同时存放HTML和附件在同一级别，否则你最终会得到一个电子邮件与身体和附件的子项目在另一个附件中的情况。 （这是奇怪，但真） 因此，这是我的解决方案：

Sub Send_Lotus_Email(Addresses, Attach, strSubject, strBody) 

'Declare Variables 
Dim s As Object 
Dim db As Object 
Dim body As Object 
Dim bodyChild As Object 
Dim header As Object 
Dim stream As Object 
Dim host As String 
Dim message As Object 

' Notes variables 
Set s = CreateObject("Notes.NotesSession") 
Set db = s.CurrentDatabase 
Set stream = s.CreateStream 

' Turn off auto conversion to rtf 
s.ConvertMIME = False 

' Create message 
Set message = db.CreateDocument 
message.Form = "memo" 
message.Subject = strSubject 
message.SendTo = Addresses 
message.SaveMessageOnSend = True 

' Create the body to hold HTML and attachment 
Set body = message.CreateMIMEEntity 

'Child mime entity which is going to contain the HTML which we put in the stream 
Set bodyChild = body.CreateChildEntity() 
Call stream.WriteText(strBody) 
Call bodyChild.SetContentFromText(stream, "text/html;charset=iso-8859-1", ENC_NONE) 
Call stream.Close 
Call stream.Truncate 

' This will run though an array of attachment paths and add them to the email 
For i = 0 To UBound(Attach) 
    strAttach = Attach(i) 
    If Len(strAttach) > 0 And Len(Dir(strAttach)) > 0 Then 
     ' Get the attachment file name 
     pos = InStrRev(strAttach, "\") 
     Filename = Right(strAttach, Len(strAttach) - pos) 

     'A new child mime entity to hold a file attachment 
     Set bodyChild = body.CreateChildEntity() 
     Set header = bodyChild.CreateHeader("Content-Type") 
     Call header.SetHeaderVal("multipart/mixed") 

     Set header = bodyChild.CreateHeader("Content-Disposition") 
     Call header.SetHeaderVal("attachment; filename=" & Filename) 

     Set header = bodyChild.CreateHeader("Content-ID") 
     Call header.SetHeaderVal(Filename) 

     Set stream = s.CreateStream() 
     If Not stream.Open(strAttach, "binary") Then 
      MsgBox "Open failed" 
     End If 
     If stream.Bytes = 0 Then 
      MsgBox "File has no content" 
     End If 

     Call bodyChild.SetContentFromBytes(stream, "application/msexcel", ENC_IDENTITY_BINARY)' All my attachments are excel this would need changing depensding on your attachments. 
    End If 
Next 

'Send the email 
Call message.Send(False) 

s.ConvertMIME = True ' Restore conversion 

End Sub 

Answer 2

没有对不起，我没有我在VBA运行此这是不强类型，所以我可以不知道实际的变量类型脱身为身体身份。我已经不能够测试这一点，但我相信你需要声明重置

Dim bodyChild As NotesMIMEEntity

这是你与那些麻烦的一个波纹管，你会发现可能会带来问题

Dim s As New NotesSession 

Dim db As NotesDatabase 

Dim body As NotesMIMEEntity 

Dim header As NotesMIMEHeader 

Dim stream As NotesStream 

Dim host As String 

Dim message As NotesDocument 

希望这会有帮助

Answer 3

这是我的实际代码。我甚至没有使用强类型。

Dim mobjNotesSession As Object  ' Back-end session reference' 
Dim bConvertMime As Boolean 
Dim stream As Object 
Dim mimeHtmlPart As Object 
Const ENC_QUOTED_PRINTABLE = 1726 

mobjNotesSession = CreateObject("Lotus.NotesSession") 
mobjNotesSession.Initialize() 

mobjNotesDatabase = mobjNotesSession.GetDatabase("HQ2", "tim4") 
mobjNotesDocument = mobjNotesDatabase.CreateDocument 

bConvertMime = mobjNotesSession.ConvertMime 
mobjNotesSession.ConvertMime = False 
stream = mobjNotesSession.CreateStream() 
Call stream.WriteText(txtBody.Text) 

mobjNotesBody = mobjNotesDocument.CreateMIMEEntity("Body") 
mimeHtmlPart = mobjNotesBody.CreateChildEntity() 'This returns "Type Mismatch" error' 
Call mimeHtmlPart.SetContentFromText(stream, "text/html; charset=""iso-8859-1""", ENC_QUOTED_PRINTABLE) 

Call stream.Close() 
mobjNotesSession.ConvertMime = bConvertMime 
Call mobjNotesDocument.CloseMIMEEntities(True, "Body")