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

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属性来检查。您可能想看 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