How to Check if BCC field is empty

Question

To prevent the sending of mass emails to recipients in the To field, a popup message can appear when sending to more than X number of recipients.

I have created a code that will do just this.

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 below has helped me with the problem! The code at the top works as intended to check both To and BCC fields before sending!

user_1140579 · Answer

You can use 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

Note: The above code is just an example to count the number of email in BCC field. If you want to just check if BCC field is empty or not then you can do this as well.

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

EDIT: Optimizing the code

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

1 Answers