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

Question

为防止向 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 字段！

Answer 1

您可以使用Recipient.Type property to check for that. You may want to see 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

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

How to Check if BCC field is empty

email

outlook

vba

bcc