Sending Email from Lotus Notes using Excel and having Attachment & HTML body

Right I'm trying to send an Email form an excel spreadsheet though lotus notes, it has an attachment and the body needs to be in HTML.

I've got some code that from all I've read should allow me to do this however it doesn't. Without the HTML body the attachment will send, when I impliment a HTML body the Email still sends but the attachment dissapears, I've tried rearanging the order of the code cutting out bits that might not be needed but all is invain.

(You need to reference Lotus Domino Objects to run this code. strEmail is the email addresses strAttach is the string location of the attachment strSubject is the subject text strBody is the body text )

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 开发者_如何学JAVAnoDocument
    .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

If somone could point me in the right direction I'd be greatly appreciated.

Edit: I've done a little more investigating and I've found an oddity, if i look at the sent folder the emails all have the paperclip icon of having an attachment even though when you go into the email even in the sent the HTML ones don't show an attachment.

I have managed to solve my own problem.

In teh same way you create a MIME entry and stream in the HTML you need to do the same with the attachment, you also need to put them both inside a MIME entry within the email itself to hold both the HTML and Attachment at the same level otherwise you end up with a situation of the email with the body and a child entry of the attachment which is within another attachment. (it's odd but true) Thus this is my solution:

    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

Here is my actual code. I'm not even using strong type.

 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")

No sorry I didn't i was running this in VBA which isn't strong typed so i can get away with not knowing the actual variable type for the body identity. i 've not been able to test this but I belive you need to reset the declarations to

Dim bodyChild As NotesMIMEEntity

this is the one you have trouble with the ones bellow you may find cause problems as well

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

Hope this helps