如何设置向非mycompany.com域邮箱发送邮件时的提示功能？

需求：仅当邮件收件人（含收件人、抄送、密送）中存在后缀非mycompany.com的外域邮箱时，发送前触发警告提示；当前所有邮件都触发提示，需调整为符合上述条件才触发。

以下是实现该需求的VBA代码：

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim xMailItem As Outlook.MailItem
Dim xRecipients As Outlook.Recipients
Dim i As Long
Dim xRecipientAddress As String
Dim xPrompt As String
Dim xYesNo As Integer
Dim xPos As Integer
On Error Resume Next

' 仅处理邮件类型的项目
If Item.Class <> olMail Then Exit Sub
Set xMailItem = Item
Set xRecipients = xMailItem.Recipients

' 遍历所有收件人，检查是否存在外域邮箱
For i = xRecipients.Count To 1 Step -1
    xRecipientAddress = xRecipients.Item(i).Address
    ' 转换为小写后检查是否包含公司域名后缀
    xPos = InStrRev(LCase(xRecipientAddress), "@mycompany.com")
    ' 发现外域邮箱则跳出循环，准备触发警告
    If xPos <= 0 Then Exit For
Next

' 如果所有收件人都是公司内域邮箱，直接退出不提示
If InStrRev(LCase(xRecipientAddress), "@mycompany.com") > 0 Then Exit Sub

' 显示警告提示框
xPrompt = "确认要向公司外部发送此邮件吗？"
xYesNo = MsgBox(xPrompt, vbYesNo + vbQuestion, "外域邮件警告")
' 用户选择“否”则取消发送
If xYesNo = vbNo Then Cancel = True

End Sub

代码关键逻辑说明 #

• 类型过滤：先校验发送项目是否为邮件，非邮件直接跳过处理
• 收件人遍历：反向遍历所有收件人（含抄送、密送），逐个检查邮箱后缀
• 域名匹配：统一转小写后用InStrRev精准匹配公司域名，避免大小写干扰
• 触发规则：只要检测到任意一个外域收件人，就触发警告；全内域收件人则直接放行
• 发送控制：用户选择取消时，通过Cancel = True终止邮件发送

内容的提问来源于stack exchange，提问作者Michael A