如何检查密件抄送字段是否为空

问题描述

为了防止向 To 字段中的收件人发送大量电子邮件，当向超过 X 个收件人发送邮件时，可能会出现一个弹出消息。

我已经创建了一个代码来做到这一点。

Private Sub Application_ItemSend(ByVal Item As Object,Cancel As Boolean)
    Dim Warn As String
    Dim Warn2 As String
    Dim Popup As String
    Dim Popup2 As String
    Dim bcccount As Long
    Dim tocount As Long
    Dim i As Long
    Dim i2 As Long
    
    Warn = "Please check if email addresses are in BCC! Click OK to send anyway"
    Warn2 = "Are you sure you want to send?"
    
    For i2 = 1 To Item.Recipients.Count
        If Item.Recipients(i2).Type = olTo Then tocount = tocount + 1
    Next i2
    
    For i = 1 To Item.Recipients.Count
        If Item.Recipients(i).Type = olBCC Then bcccount = bcccount + 1
    Next i
    
    If tocount > 4 And bcccount = 0 Then
    
        Popup = MsgBox(Warn,vbOKCancel + vbCritical)
            If Popup <> vbOK Then
                Cancel = True
             ElseIf MsgBox(Warn2,vbYesNo + vbQuestion) <> vbYes Then
                Cancel = True
            End If
    
    End If
    End Sub

下面的 Sidd 帮我解决了这个问题！顶部的代码按预期在发送前检查 To 和 BCC 字段！

解决方法

您可以使用 Recipient.Type 属性进行检查。您可能希望看到OlMailRecipientType enumeration (Outlook)

Dim bcccount As Long
Dim i As Long

For i = 1 To Item.Recipients.Count
    If Item.Recipients(i).Type = olBCC Then bcccount = bcccount + 1
Next i

MsgBox bcccount

注意：以上代码只是计算密件抄送字段中电子邮件数量的示例。如果您只想检查 BCC 字段是否为空，那么您也可以这样做。

Dim i As Long

For i = 1 To Item.Recipients.Count
    If Item.Recipients(i).Type = olBCC Then
        '~~> Do what you want
        MsgBox "Found an item in BCC"
        Exit For
    End If
Next i

编辑：优化代码

Const msgA As String = "Please check if email addresses are in BCC! Click OK to send anyway"

Private Sub Application_ItemSend(ByVal Item As Object,Cancel As Boolean)
    Dim ToCount As Long,BCCCount As Long
    Dim i As Long
    Dim Ret As Variant
    
    For i = 1 To Item.Recipients.Count
        Select Case Item.Recipients(i).Type
        Case olTo: ToCount = ToCount + 1
        Case olBCC:: BCCCount = BCCCount + 1
        End Select
    Next i
    
    If ToCount > 4 And BCCCount = 0 Then
        Ret = MsgBox(msgA,vbOKCancel + vbCritical,"Alert")
        
        If Ret <> vbOK Then Cancel = True
    End If
End Sub