Boa noite queridos,

Tenho código para envio de e-mail através do Lotus Notes porém não consigo copiar um range e colar no body do e-mail como imagem.

Alguém saberia fazer?

Obrigada!

Dim Subject, BodyText, SendTo, Cc, Bcc As String
Dim Attachment, AttachmentType As String

'Set up the objects required for Automation into lotus notes
Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDbName As String 'The current users notes mail database name
Dim MailDoc As Object 'The mail document itself
Dim Session As Object 'The notes session
Dim Body As Object
Dim BodyChild As Object 'Html text & the attachment
Dim Header As Object
Dim Stream As Object

Sub SendEmail()

        Subject = "teste"
        BodyText = "teste"
        recep = "teste@mail.com"
        recepcc = "testeCC@mail.com"
        recepbcc = "testeBcc@mail.com"
        Attachment = ActiveWorkbook.FullName
            
        Dim iii As Long, FileName As String, AttachmentTypee, a(1 To 1)
        
        'Initialize
        Set Session = CreateObject("Notes.NotesSession")
        Session.CONVERTMIME = False
        UserName = Session.UserName
        MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
            
        'Open the mail database in notes
        Set Maildb = Session.GETDATABASE("", MailDbName)
        If Not Maildb.IsOpen Then Maildb.OPENMAIL
            
        'Set up the new mail document
        Set MailDoc = Maildb.CREATEDOCUMENT
        MailDoc.Form = "Memo"
        Call MailDoc.AppendItemValue("SendTo", recep)
        Call MailDoc.AppendItemValue("Copyto", recepcc)
        Call MailDoc.AppendItemValue("BlindCopyTo", recepbcc)
        MailDoc.Subject = Subject
            
        'Set up the body html text
        Set Body = MailDoc.CREATEMIMEENTITY
        Set BodyChild = Body.CREATECHILDENTITY
        Set Stream = Session.CREATESTREAM
        Stream.WriteText BodyText
        BodyChild.SETCONTENTFROMTEXT Stream, "text/html;charset=iso-8859-1", ENC_IDENTITY_8BIT
        Stream.Close
        Stream.TRUNCATE
            
        'Set up the attachments
        If Not IsArray(Attachment) Then If Len(Attachment) Then a(1) = Attachment: Attachment = a
            
        If IsArray(Attachment) Then
            For iii = LBound(Attachment) To UBound(Attachment)
                FileName = Dir(Attachment(iii))
                If Len(FileName) Then
                    Set BodyChild = Body.CREATECHILDENTITY
                    Set Header = BodyChild.CREATEHEADER("Content-Type")
                    Header.SETHEADERVAL "multipart/mixed"
                    Set Header = BodyChild.CREATEHEADER("Content-Disposition")
                    Header.SETHEADERVAL "attachment; filename=" & Chr(34) & FileName & Chr(34)
                    Set Header = BodyChild.CREATEHEADER("Content-ID")
                    Header.SETHEADERVAL FileName
                    Set Stream = Session.CREATESTREAM
                    If Stream.Open(Attachment(iii), "binary") Then
                        AttachmentTypee = Split(Attachment(iii), ".")
                        AttachmentTypee = "application/" & AttachmentTypee(UBound(AttachmentTypee))
                        BodyChild.SETCONTENTFROMBYTES Stream, AttachmentTypee, ENC_IDENTITY_BINARY
                    End If
                End If
            Next iii
        End If
            
        'Send the document
        MailDoc.SaveMessageOnSend = True
        MailDoc.PostedDate = Now()
        Call MailDoc.Send(False)
        
        MsgBox "Email successfully sent", vbInformation
        
ErrHdl:
    If Err.Number Then MsgBox "VBA error: " & Err.Description, vbCritical, "Lotus Notes Email"
        'Clean Up
        On Error Resume Next
        Session.CONVERTMIME = True
        Set Body = Nothing
        Set BodyChild = Nothing
        Set Header = Nothing
        Set Maildb = Nothing
        Set MailDoc = Nothing
        Set Session = Nothing
        Set Stream = Nothing

End Sub