OutLook统计收件人

suke_008

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

AZA

原帖由 suke_008 于 2009-6-4 07:10 发表
大家好,我们公司个人邮箱在发送时有限制收件人数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

aaaaabbbbb

将以下代码拷贝到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

AZA

呵呵，谢谢加分啊！

suke_008

感谢啦!!~~~

305117

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

Eileen_Gu

请教下，在Outlook中按Alt+F11，把代码放在Thisoutlooksession中后，还需要做什么动作啊~~没有用过VBA，完全不了解啊~~感谢帮忙啊

hegi

收藏了，很不错！