OutLook统计收件人

大家好,我们公司个人邮箱在发送时有限制收件人数50,如果超出将无法传送.
可否用VBA实现在准备发送时提示收件者&副本以及密件人各多少个？也就是做个统计.谢谢！！

在Outlook中按Alt+F11，把下面的代码放在Thisoutlooksession中：
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim Prompt As String
Dim Button As String
Dim Title As String

Prompt = "本邮件收件人总数为: " & Item.Recipients.Count & ".为了能发出邮件,请至少删除: " & Item.Recipients.Count - 50 & " 个收件人."
Button = vbOKOnly
Title = "提示"

If Item.Recipients.Count > 50 Then
    MsgBox Prompt, Button, Title
    Cancel = True
End If

End Sub

将以下代码拷贝到Thisoutlooksession下面。
Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)

Dim NumberofTo As Long
Dim NumberofCC As Long
Dim NumberofBCC As Long

If item.Class = olMail Then
    For Each Recipient In item.Recipients
        If Recipient.Type = olTo Then
            NumberofTo = NumberofTo + 1
            Else
            If Recipient.Type = olCC Then
                NumberofCC = NumberofCC + 1
                Else
                If Recipient.Type = olBCC Then
                    NumberofBCC = NumberofBCC + 1
                End If
            End If
        End If
    Next
End If

If item.Recipients.count >= 50 Then
    MsgBox "收件人&抄送人以及密件人总和不可以超过50个, 此邮件有" & NumberofTo & "个收件人,有" & NumberofCC & "个抄送人,有" & NumberofBCC & "个密送抄送人.请修改."
    Cancel = True
    Exit Sub
End If

End Sub

呵呵，谢谢加分啊！

感谢啦!!~~~

挺实用，我公司也限制只能发50人