Notifications
Clear all

Adaptar Código 1 (Anexar Documento)

3 Posts
2 Usuários
0 Reactions
1,129 Visualizações
(@carlosrgs)
Posts: 0
New Member
Topic starter
 

Bom dia pessoal.

A algum tempo abri um tópico, para ver se conseguia ajuda para anexar um PDF num email.

Inicialmente tenho esse código que envia o email normalmente.

Sub Código_01_EnviarEmailViaNotes()
    Dim notesSession As Object
    Dim notesMailFile As Object
    Dim notesDocument As Object
    Dim notesField As Object
    Dim receptores(2) As Variant
        
    'Cria Uma lista de destinatários
    receptores(0) = Plan1.[C2]
    
    'Abre uma sessão do notes, abre a base de dados e cria um documento.
    Set notesSession = CreateObject("Notes.NotesSession")
    Set notesMailFile = notesSession.GetDataBase("", "names.nsf")  '- *.nsf = arq. com lista de contatos
    Set notesDocument = notesMailFile.CreateDocument
    
    'Configura Subject, SendTo e Abre um nomo corpo de e-mail
    Set notesField = notesDocument.AppendItemValue("Subject", "Email no Excel XD...")
    Set notesField = notesDocument.AppendItemValue("SendTo", receptores)
    Set notesField = notesDocument.CreateRichTextItem("Body")
        
    'Escreve o texto padrão no e-mail.
    With notesField
        .AppendText Plan1.[C4]
        .AddNewLine (2)
        .AppendText Plan1.[C6]
        .AddNewLine (1)
        .AppendText Plan1.[C8]
        .AddNewLine (3)
'        .AppendText Cells(1, 1).Value   'aqui faz referencia a uma variável ou a uma parte da planilha
    End With
       

    'Envia o e-mail
    notesDocument.Send False
    
    'Limpa as variáveis
    Set notesSession = Nothing
    Set notesMailFile = Nothing
    Set notesDocument = Nothing
    Set notesField = Nothing
End Sub

Recentemente achei esse código que anexou o documento como eu quero.

Sub Código_02_Anexa()
Dim resultado As VbMsgBoxResult
     resultado = MsgBox("Você está com o lotus notes aberto?", vbYesNo, "Salvar e enviar notes")
     If resultado = vbYes Then
          
Application.DisplayAlerts = False
        ActiveWorkbook.Save

    Application.DisplayAlerts = True
             
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 AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
'Start a session to notes
Set Session = CreateObject("Notes.NotesSession")

Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
'Already open for mail
Else
Maildb.OPENMAIL
End If
'Set up the new mail document
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
Dim recip(25) As Variant
recip(0) = "carlossantos@cacique.com.br"

MailDoc.sendto = recip

MailDoc.Subject = "Formulário SISCOSERV foi atualizado."
'BodyText = ""
'MailDoc.Body = BodyText
  
MailDoc.SaveMessageOnSend = SaveIt
'Set up the embedded object and attachment and attach it
caminho = "C:relatoTeste.pdf"
Set AttachME = MailDoc.CreateRichTextItem("Attachment")
Set EmbedObj = AttachME.EmbedObject(1454, "", caminho, "Attachment")


'Send the document
MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items FOLDER
MailDoc.Send 0, Recipient
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
Else
resultado = MsgBox("Favor abrir e depois salvar novamente?", vbOKOnly, "Salvar e enviar notes")
End If
End Sub

Eu já tentei adaptar o código 01 com a parte para anexar documento do código 02, mas sem sucesso.

Alguém se arrisca ?

 
Postado : 29/05/2017 5:37 am
(@carlosrgs)
Posts: 0
New Member
Topic starter
 

Depois de vários testes e provar que brasileiro não desiste nunca.

Segue adaptação!

Deixar registrado para futuras consultas, pois já achei muitos tópicos em outros fóruns com esta duvida de Anexo no Notes (IBM)

Sub TesteEmailANEXO()
    Dim notesSession As Object
    Dim notesMailFile As Object
    Dim notesDocument As Object
    Dim notesField As Object
    Dim receptores(2) As Variant
    
'       Adaptado com código 2.
    Dim AttachME As Object
    Dim EmbedObj As Object
'       Fim adaptado com código 2.
    
    'Cria Uma lista de destinatários
    receptores(0) = "carlossantos@cacique.com.br"
    
    'Abre uma sessão do notes, abre a base de dados e cria um documento.
    Set notesSession = CreateObject("Notes.NotesSession")
    Set notesMailFile = notesSession.GetDataBase("", "names.nsf")  '- *.nsf = arq. com lista de contatos
    Set notesDocument = notesMailFile.CreateDocument
    
    'Configura Subject, SendTo e Abre um nomo corpo de e-mail
    Set notesField = notesDocument.AppendItemValue("Subject", "Email no Excel XD...")
    Set notesField = notesDocument.AppendItemValue("SendTo", receptores)
    Set notesField = notesDocument.CreateRichTextItem("Body")
        
'       Adaptado com código 2.
    notesDocument.SaveMessageOnSend = SaveIt
    'Configurar o objeto incorporado eo anexo e anexá-lo
    caminho = "C:relatoTeste.pdf"
    Set AttachME = notesDocument.CreateRichTextItem("Attachment")
    Set EmbedObj = AttachME.EmbedObject(1454, "", caminho, "Attachment")
'       Fim adaptado com código 2.
        
    'Escreve o texto padrão no e-mail.
    With notesField
        .AppendText Plan1.[C4]
        .AddNewLine (2)
        .AppendText Plan1.[C6]
        .AddNewLine (1)
        .AppendText Plan1.[C8]
        .AddNewLine (3)
'        .AppendText Cells(1, 1).Value   'aqui faz referencia a uma variável ou a uma parte da planilha
    End With
       
    'Envia o e-mail
    notesDocument.Send False
    
    'Limpa as variáveis
    Set notesSession = Nothing
    Set notesMailFile = Nothing
    Set notesDocument = Nothing
    Set notesField = Nothing
End Sub

Falou!

 
Postado : 01/06/2017 10:12 am
(@kbispos)
Posts: 0
New Member
 

Carlos, bom trabalho!

A maneira como eu faço é um pouquinho diferente. Mas utilizo essa macro 2. Utilizo uma segunda macro e nos parâmetros, faço call da macro que anexa o arquivo. Depois coloco aqui.

 
Postado : 01/04/2018 5:00 pm