✔ Programação GLOBAL®: VBA Outlook 2003 - Envie todas as suas mensagens por e-mails como Bcc, automaticamente.

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

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