VBA Outlook - Envia uma cópia oculta automaticamente para um e-mail.

DESENVOLVO APLICAÇÕES

Contate desenvolvedores VBA

Perguntas, Questões e Esclarecimentos

O que é o fenômeno chamado BIG DATA?

Acesse uma ENORME lista de Dashboards e Infográficos

Aprenda a detectar gráficos que precisam mudar

Dados ou Informações?

Dashboards - 8 Importantes características desejáveis

Dashboards e Infocharts - Diversas Visualizações de Dados

Diversos exemplos de Gráficos

Excel - DashMap - Mapa do Brasil

Key Performance Indicators - 7 Características desejáveis

MIS - Usufruindo a excelência na análise das suas Informações

O Melhor do Business Intelligence

Os 10 mandamentos do gerenciamento de projetos

Receba  3 Calendários Customizáveis de  2013 em Excel

Usando Gauges em Dashboards no MS Access

Desenvolvermos um código que fique incubado no nosso MS Outlook para garantir que todos os e-mails que forem enviados através dele, automaticamente faça uma cópia deste conteúdo para outro endereço específico pode ser conseguido através da programação VBA.

Se você for menos experiente no uso de automação, talvez esteja se perguntando porque é que iria desejar implementar um código assim no seu MS Outlook.  É verdade que talvez não precise deste código agora, mas certamente o utilizará alguma vez na vida, reflita nas duas situações abaixo:

Digamos que deseje auditar todas as mensagens que estão sendo enviadas através do seu MS Outlook, recebendo uma cópia de qualquer mensagem que enviarem. Como fazer isso?

Quem sabe, queira guardar em uma conta de e-mail externa, o conteúdo de todos os e-mails enviados diariamente da sua máquina, através do MS Outlook, para garantir que nada se perca caso hajam problemas com o seu servidor local de e-mails, como fazer isso?

Private Sub Application_ItemSend (ByVal Item As Object, _

                                 Cancel As Boolean)

    '        Author: André Luiz Bernardes - bernardess@gmail.com

    '          Date: 05/08/13 - 16:03

    '   Application: OutlookFunctionalities®

    ' Functionality: Envia uma cópia oculta automaticamente para um e-mail.

    

    Dim objRecip As Recipient

    Dim strMsg As String

    Dim res As Integer

    Dim strBcc As String

    On Error Resume Next

    

    Let strBcc = "bernardess@gmail.com"

    Set objRecip = Item.Recipients.Add(strBcc)

    

    Let objRecip.Type = olBCC

    

    If Not objRecip.Resolve Then

        Let strMsg = "O Outlook não consegue enviar a mensagem para este endereço de e-mail BCC. " & _

                 "Deseja continuar enviando a mensagem?"

        Let res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _

                "Não consigo decifrar este endereço Bcc")

        

        If res = vbNo Then

            Let Cancel = True

        End If

    End If

    Set objRecip = Nothing

End Sub

brazilsalesforceeffectiveness@gmail.com

       

VBA LOTUS NOTES DOMINO - Código de envio de e-mails

Algumas pessoas no ano passado e já neste ano solicitaram código sobre como enviar e-mail no Lotus Notes Domino.

Seguem possibilidades de fazê-lo. Como sempre, divirtam-se:

Public Sub EnviarMailViaNotes (Subject As String, Attachment As String, Recipient As String, BodyText As String, SaveIt As Boolean)

    Dim Maildb As Object

    Dim UserName As String 

    Dim MailDbName As String 

    Dim MailDoc As Object

    Dim AttachME As Object 

    Dim Session As Object 

    Dim EmbedObj As Object 

    Set Session = CreateObject("Notes.NotesSession")

    Session.Initialize("password")

   

    Let UserName = Session.UserName

    

    Let MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"

    

    Set Maildb = Session.GETDATABASE("", MailDbName)

     If Maildb.ISOPEN = True Then

          

     Else

         Maildb.OPENMAIL

     End If

    

    Set MailDoc = Maildb.CREATEDOCUMENT

    

    Let MailDoc.Form = "Memo"    
    Let MailDoc.sendto = Recipient
    Let MailDoc.Subject = Subject    
    Let MailDoc.Body = BodyText    
    Let MailDoc.SAVEMESSAGEONSEND = SaveIt

    

    If Attachment <> "" Then

        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")

        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")

        MailDoc.CREATERICHTEXTITEM ("Attachment")

    End If

    

    

    Let MailDoc.PostedDate=Now() 

    MailDoc.SEND 0, Recipient

    

    Set Maildb = Nothing

    Set MailDoc = Nothing

    Set AttachME = Nothing

    Set Session = Nothing

    Set EmbedObj = Nothing

End Sub

Se desejar enviar o e-mail para mais de uma pessoa, Let MailDoc.sendto = Recipient

Let MailDoc.CopyTo = ccRecipientLet MailDoc.BlindCopyTo = bccRecipient

Se desejar enviar para múltiplos e-mails, que tenham sido carregados num vetor,

Dim recip(25) as variant

Let recip(0) = "emailaddress1"

Let recip(1) = "emailaddress2" e.t.c

Let maildoc.sendto = recip

OUTRO MODO

Sub SendMailAttachment () 

    Dim strBOdocument As String 

    Dim strBOUserDocsPath As String 

    

    Let strBOUserDocsPath = busobj.ActiveDocument.Path & "\" 

    

    

    Let strBOdocument = Application.ActiveDocument.Name 

    

    Application.ActiveDocument.SaveAs (strBOUserDocsPath & strBOdocument & ".xls")    

    Dim domSession As New NotesSession 

    Dim domNotesDBMailFile As NotesDatabase 

    Dim domNotesDocumentMemo As NotesDocument 

    Dim domNotesRichText As NotesRichTextItem 

    Dim strAttachment As String 

    

    domSession.Initialize ("")

    

    Set domNotesDBMailFile = domSession.GetDatabase("", "names.nsf") 

    Set domNotesDocumentMemo = domNotesDBMailFile.CreateDocument 

    

    Call domNotesDocumentMemo.AppendItemValue("Form", "Memo") 

    Call domNotesDocumentMemo.AppendItemValue("SendTo", domSession.CommonUserName) 

    Call domNotesDocumentMemo.AppendItemValue("Subject", strBOdocument) 

    

    Set domNotesRichText = domNotesDocumentMemo.CreateRichTextItem("Body") 

    

    strAttachment = strBOUserDocsPath & strBOdocument & ".xls" 

    

    Call domNotesRichText.EmbedObject(EMBED_ATTACHMENT, "", strAttachment, "") 

    

    domNotesRichText.AppendText (InputBox("Digite algum texto adicional que deseje acrescentar.", _ 

    " Este aparecerá no corpo do e-mail.")) 

    

    domNotesDocumentMemo.Send (False) 

End Sub

Evoque-o assim:

Private Sub Document_AfterRefresh() 
    ThisDocument.ExecuteMacro ("SendMailAttachment") 
End Sub 

Private Sub Document_AfterRefresh() 
    SendMailAttachment 
End Sub

Tags: Bernardes, VBA, Office, e-Mail, Send, Mail, Lotus, Notes, Domino, Attachment, Recipient, CCo, Bco, CC

André Luiz Bernardes

A&A® - Work smart, not hard.

VBA Blogs

  

bernardes@.com