Outlook VBA开发：检测收件人含3位以上数字的组，缺失则弹窗提示

需要通过Outlook VBA实现以下功能：

• 检查邮件的收件人（To）和抄送（CC）字段中，是否存在包含至少3位连续数字的联系人组（格式示例：0239-Customer-Location-Description）
• 由于这类组数量多且频繁变更，需用通配符匹配统计符合条件的组数量
• 当符合条件的组数量为0时，用户点击发送按钮后弹出确认提示，确认是否继续发送

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

Dim prompt As String
prompt = "Has your group added? Select Yes to send anyway"

Dim Recipients As Outlook.Recipients
Dim Recip As Outlook.Recipient
Dim Find As String

Dim GroupCount As Long

Find = "*###*"

Set Recipients = Item.Recipients
  For Each Recip In Recipients
      If InStr(1, Recip.Address, Find, vbTextCompare) Then GroupCount = GroupCount + 1 Else: GroupCount = GroupCount
     Exit For
     Next

 'check to see if count is working   
If MsgBox(GroupCount, vbOKOnly, "Group Count") = vbOK Then
    Cancel = True

    If GroupCount = 0 Then
         If MsgBox(prompt, vbYesNo + vbQuestion, "CC Field") = vbNo Then
            Cancel = True
        End If
    End If
End If
End Sub

1. 循环提前终止：Exit For导致仅检查第一个收件人就跳出循环，无法遍历所有收件人（To/CC/BCC都会被包含在Recipients集合里）
2. 通配符匹配错误：InStr函数不支持通配符，应该使用Like操作符来匹配*###*格式
3. 错误的检查字段：Recip.Address通常是SMTP地址或Exchange地址，应该检查Recip.Name（联系人组的显示名称）才符合需求
4. 测试代码干扰逻辑：用于测试的MsgBox(GroupCount...)会强制取消发送，且逻辑顺序混乱，需要移除
5. 逻辑顺序错误：应该先统计数量，再判断是否为0并弹出确认提示，而非被测试弹窗打断

Private Sub myOlApp_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim prompt As String
    prompt = "未添加符合要求的联系人组，是否确认发送邮件？"
    
    Dim Recipients As Outlook.Recipients
    Dim Recip As Outlook.Recipient
    Dim GroupCount As Long
    
    Set Recipients = Item.Recipients
    '遍历所有收件人（To/CC/BCC）
    For Each Recip In Recipients
        '用Like匹配包含至少3位连续数字的组名
        If Recip.Name Like "*###*" Then
            GroupCount = GroupCount + 1
        End If
    Next Recip
    
    '如果没有找到符合条件的组，弹出确认提示
    If GroupCount = 0 Then
        If MsgBox(prompt, vbYesNo + vbQuestion, "发送确认") = vbNo Then
            Cancel = True '用户选择No，取消发送
        End If
    End If
End Sub

• 代码会遍历邮件所有收件人（包括To、CC、BCC），检查每个收件人的显示名称是否包含至少3位连续数字
• 当统计数量为0时，弹出确认框，用户选择「否」则取消邮件发送，选择「是」则继续发送
• 若需要仅检查To和CC字段，可在循环中添加判断：If Recip.Type = olTo Or Recip.Type = olCC Then

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