On Error Goto trataerro
Dim session As New notessession
Dim db As notesdatabase
Dim coll As notesdocumentcollection
Dim visao As NotesView
Dim docmail As NotesDocument
Dim docLogo As NotesDocument
Dim rtitem As Variant
Dim filename As Variant
Dim filepath As String
Dim filesname As String
Dim sizeInBytes As Long
Dim notesEmbeddedObject As NotesEmbeddedObject
Set db = session.currentdatabase
'seta o doc p/envio
Set docmail = New NotesDocument(db)
Dim mimeRoot As NotesMimeEntity, mime As NotesMimeEntity
Dim header As NotesMimeHeader
Dim stream As NotesStream
session.ConvertMIME = False ' Do not convert MIME to rich text
Set stream = session.CreateStream()
' Create main MIME message
Set stream = session.CreateStream
Set MIMERoot = docmail.CreateMIMEEntity ' message root
' Create child entities
Set mime = MIMERoot.CreateChildEntity
Set header = MIMERoot.getNthHeader("Content-Type")
Call header.SetHeaderVal("multipart/related")
'seta o path default
filepath = "D:\Diretorio\"
'//seta a visão
Set visao = db.getView("vwLogo")
'//seta o doc. com a imagem a ser anexada no e-mail
Set docLogo = visao.getDocumentByKey("img_LOGO.JPG", True)
'verifica se o documento foi setado corretamente
If docLogo Is Nothing Then
Msgbox "Documento com a imagem não foi encontrado",16,"Operação Cancelada"
Exit Sub
End If
'//seta o nome do anexo
filename = docLogo.ASName(0) ' //ca_labelAnexo
'seta o anexo
Set notesEmbeddedObject = docLogo.GetAttachment( filename )
'verifica se o anexo foi setado corretamente
If notesEmbeddedObject Is Nothing Then
Msgbox "Imagem não encontrada",16,"Operação Cancelada"
Exit Sub
End If
'extrai o anexo
Call notesEmbeddedObject.ExtractFile( filepath & filename )
' Create Message
Call stream.WriteText(|
| | & |1. Imagem => | & | | | & Oribody & | | | & _ |  |
Call mime.SetContentFromText(stream,"text/html",ENC_NONE)
Call stream.Close
' Create inline image reference
Set mime = MIMERoot.CreateChildEntity
'Call stream.Open(filepath & filename )
If Not stream.Open(filepath & filename ) Then
Msgbox "Open failed"
Exit Sub
End If
If stream.Bytes = 0 Then
Msgbox "File has no content"
Exit Sub
End If
Call mime.SetContentFromBytes(stream, "image/jpeg",ENC_NONE)
Call stream.Close
Call mime.EncodeContent(ENC_BASE64)
Set header = mime.CreateHeader("Content-ID")
Call header.SetHeaderVal("
Call docmail.Send(False, "DESTINATARIO")
' Call docmail.Send(false
session.ConvertMIME = True ' Restore conversion
Exit Sub
trataerro:
Msgbox "Error - Linha: " & Cstr(Erl) & " Tipo: "&Cstr(Error) & " " & Cstr(Error)
Exit Sub
End Sub
