¿Cómo verificar las direcciones de los destinatarios antes de enviar un mensaje en Outlook?

A veces, es posible que olvide incluir destinatarios importantes en los campos Para, CC o CCO al enviar correos electrónicos mediante Outlook. A continuación, le presentamos un método para verificar si se han añadido direcciones de correo electrónico específicas antes del envío a través de Outlook.

Comprobar direcciones antes de enviar con código VBA

---

Comprobar direcciones antes de enviar con código VBA

Aquí tiene dos códigos que le ayudarán a completar esta tarea; puede elegir el que mejor se adapte a sus necesidades.

1. Pulse Alt + F11 para abrir la ventana de Microsoft Visual Basic para Aplicaciones.

2. Haga doble clic en ThisOutlookSession en el panel de Project1 para abrir el editor de código y copie y pegue el siguiente código en él.

VBA: comprobar la dirección del destinatario en el campo Para antes de enviar

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'UpdatebyExtendoffice20180523
Dim xAddressArr() As Variant
Dim xAddress As String
Dim xRecipient As Recipient
Dim xPrompt As String
Dim xYesNo As Integer
Dim xDictionary As Scripting.Dictionary
On Error Resume Next
Set xDictionary = New Scripting.Dictionary
xAddressArr = Array("example1@126.com", "example2@126.com", "example3@126.com")
For i = LBound(xAddressArr) To UBound(xAddressArr)
    xDictionary.Add xAddressArr(i), True
Next i
For Each xRecipient In Item.Recipients
    If xRecipient.Type = olTo Then
        If xDictionary.Exists(xRecipient.Address) Then xDictionary.Remove xRecipient.Address
    End If
Next
If xDictionary.Count = 0 Then GoTo L1
For i = 0 To xDictionary.Count - 1
    If xAddress = "" Then
        xAddress = xDictionary.Keys(i)
    Else
        xAddress = xAddress + "; " & xDictionary.Keys(i)
    End If
Next i
xPrompt = "You are not sending this to: " & xAddress & ". Are you sure you want to send the Mail?"
xYesNo = MsgBox(xPrompt, vbQuestion + vbYesNo, "Kutools for Outlook")
If xYesNo = vbNo Then Cancel = True
L1:
  Set xRecipient = Nothing
  Set xDictionary = Nothing
End Sub

En el código, puede reemplazar («example1@126.com», «example2@126.com», «example3@126.com») por las direcciones de correo reales a las que desee enviar.

3. A continuación, en la ventana de Microsoft Visual Basic para Aplicaciones, haga clic en Herramientas > Referencias. En el cuadro de diálogo Referencias: Project1, marque la casilla de verificación de Microsoft Scripting Runtime.

4. Haga clic en Aceptar y guarde el código.

Ahora, si los destinatarios especificados no aparecen en el campo Para al enviar correos electrónicos, se mostrará un cuadro de diálogo preguntándole si desea enviar el mensaje.

Con el código anterior, solo se comprueba la dirección de correo electrónico en el campo Para. Si desea comprobarla también en los campos Para, CC y CCO, puede utilizar el siguiente código.

VBA: comprobar la dirección del destinatario en los campos Para/CC/CCO antes de enviar

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'UpdatebyExtendoffice20180523
Dim xRecipients As Outlook.Recipients
Dim xRecipient As Outlook.Recipient
Dim xPos As Integer
Dim xYesNo As Integer
Dim xPrompt As String
Dim xAddress As String
On Error Resume Next
If Item.Class <> olMail Then Exit Sub
Set xRecipients = Item.Recipients
xAddress = "example1@gmail.com"
For Each xRecipient In xRecipients
    xPos = InStr(LCase(xRecipient.Address), xAddress)
    If xPos = 0 Then
        xPrompt = "You sending this to " & xAddress & ". Are you sure you want to send it?"
        xYesNo = MsgBox(xPrompt, vbYesNo + vbQuestion + 4096, "Kutools for Outlook")
        If xYesNo = vbNo Then Cancel = True
    End If
Next xRecipient
End Sub

Con este código, no es necesario marcar la casilla de Microsoft Scripting Runtime; basta con guardar el código directamente para que surta efecto.