Outlook VBA验证收件人

时间:2015-07-06 13:51:11

标签: vba outlook

在发送之前检查多个黑名单电子邮件地址的最佳方法是什么?

我有几个电子邮件地址我不允许作为项目的一部分发送信息。我希望Outlook检查任何黑名单电子邮件地址,并在发送之前通知我它们是否包含在内。下面是我发现修改的代码

例如,我的黑名单包括:“bad@address.com”,“worst@address.com”,“evil@address.com”

将这些地址放入下面的代码中的最佳方法是什么,这样可以很容易地改变黑名单中的地址?

以下是我的代码的最新版本以及您的建议。不幸的是,它允许我将电子邮件发送到清单上的地址。有什么建议吗?

  Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

  Dim Recipients As Outlook.Recipients
  Dim recip As Outlook.Recipient
  Dim i
  Dim prompt As String


On Error Resume Next
 ' use lower case for the address
 ' LCase converts all addresses in the To field to lower case

  Checklist = "bad@address.com" & _
            "worst@address.com" & _
            "evil@address.com" '// , _ and so on

 Set Recipients = Item.Recipients
  For i = Recipients.Count To 1 Step -1
    Set recip = Recipients.Item(i)

 If InStr(LCase(recip), LCase(Checklist)) Then
      prompt$ = "You sending this to this to " & Item.To & ". Are you sure you want to send it?"
       If MsgBox(prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
         Cancel = True
       End If
  End If

Next i


End Sub

1 个答案:

答案 0 :(得分:1)

创建一个程序级变量 CheckList ,这是黑名单电子邮件的csv列表。您可以在过程中将其初始化为硬分配,或者从其他数据源动态检索,例如, sql server

Dim lbadFound  As Boolean
dim badAddresses as string
lbadFound = False

CheckList = "bad@address.com," & _
            "worst@address.com," &  _
            "evil@address.com" '// , _ and so on

    Set Recipients = Item.Recipients
    For i = Recipients.Count To 1 Step -1
      Set recip = Recipients.Item(i)

      If instr(1,lcase(CheckList),  LCase(recip)) >=1 Then 
          lbadFound = true
          badAddresses  = badAddresses  & recip & & vbcrlf 
      End If

    Next i

    If lbadFound Then
       prompt$ = "You sending this mail to one or more black listed email address(es)" & badAddresses & vbcrlf & " Are you sure you want to send it?"
       If MsgBox(prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Address") = vbNo Then
         Cancel = True
       End If
    End If