检查收件人是否超过两家公司

cocojyg

  '//检查收件人是否超过两家公司(不适用于同一客户采用两种不同邮件后缀的情况)
  Dim k As Integer, i As Integer
  If Item.Recipients.Count > 1 Then
    Application.Explorers(1).Activate
    Receiver = ""
    For k = Item.Recipients.Count To 1 Step -1
      Receiver = Item.Recipients.Item(k).Address & ";" & Receiver
    Next k
    On Error Resume Next
    Set d = CreateObject("Scripting.Dictionary")
    a = Split(Receiver, ";")
    For i = 0 To UBound(a)
      b = Split(a(i), "@")
      d(b(1)) = ""
    Next
    Receiver = ""
    If d.Count > 2 Then
      lngres = MsgBox("收件公司超过两家,个数为:" & d.Count & Chr(10) & "仍然发送？", _
      vbYesNo + vbDefaultButton2 + vbQuestion, "提示")
      If lngres = vbNo Then
        Cancel = True
        Item.Display
        Exit Sub
      End If
    End If
  End If