VBA Outlook 2003 - Envie todas as suas mensagens por e-mails como Bcc, automaticamente.


O MS Outlook tem uma regra quando enviamos mensagens para outra pessoa como 'Cc', mas não tem nada equivalente para mensagens enviadas como 'BCC' (ou CCo, Oculta). Utilizaremos o evento Application.ItemSend, que é acionado sempre que um usuário envia uma mensagem.

Esta versão é ideal para o Outlook 2003 ou posterior. Ela usa objetos exclusivamente Outlook e inclui manipulação de erro para evitar problemas com um endereço inválido Bcc.

Ela usa objetos exclusivamente Outlook e inclui manipulação de erro para evitar problemas com um endereço inválido Bcc. 

Coloque esse código VBA no módulo interno de ThisOutlookSession:


1ª Versão:

Private Sub Application_ItemSend (ByVal Item As Object, Cancel As Boolean)
    Dim objRecip As Recipient
    Dim strMsg As String
    Dim res As Integer
    Dim strBcc As String
    On Error Resume Next

    strBcc = "bernardess@gmail.com"

    Set objRecip = Item.Recipients.Add(strBcc)
    objRecip.Type = olBCC

    If Not objRecip.Resolve Then
        strMsg = "Não posso enviar esta mensagem oculta. " & _
                 "Deseja continuar enviando a mensagem?"

        res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
                "Não posso enviar esta mensagem oculta.")

        If res = vbNo Then
            Cancel = True
        End If
    End If

    Set objRecip = Nothing
End Sub

A razão pela qual este método não é adequado para as versões anteriores do Outlook 2003 é porque ele dispara um alerta de segurança devido ao uso do Recipients.Add

Você pode evitar avisos de segurança, simplesmente definindo a propriedade Item.Bcc para o endereço desejado, mas terá dois problemas. Primeiro, iria retirar os destinatários Bcc que o usuário já tivesse adicionado. Além disso, em algumas configurações do Outlook, mesmo se você usar um endereço SMTP apropriado, obteria um erro, e o Outlook não enviaria a mensagem.


2ª Versão:

Esta versão utiliza a mesma técnica básica da 1ª versão, apenas adiciona a biblioteca de terceiros Outlook Redemption para evitar avisos de segurança das versões anteriores ao Outlook 2003 e, caso o beneficiário não possa ser resolvido, para mostrar ao usuário uma caixa de diálogo de resolução dos nomes.


Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    ' Requires a reference to
    ' the SafeOutlook library (Redemption.dll)

    Dim objMe As Redemption.SafeRecipient
    Dim sMail As Redemption.SafeMailItem

    On Error Resume Next
    
    Set sMail = CreateObject("Redemption.SafeMailItem")

    Item.Save

    sMail.Item = Item
    Set objMe = sMail.Recipients.Add ("bernardess@gmail.com")
    objMe.Type = olBCC

    If Not objMe.Resolve(True) Then
        Cancel = True
    End If
    
    Set objMe = Nothing
    Set sMail = Nothing
End Sub

Fonte: OutlookCode



Veja também:



Tags: Outlook 2003, send, message, mensagem, Bcc, ThisOutlookSession


André Luiz Bernardes
A&A® - Work smart, not hard.

Nenhum comentário:

Postar um comentário

diHITT - Notícias