在发送之前检查多个黑名单电子邮件地址的最佳方法是什么?
我有几个电子邮件地址我不允许作为项目的一部分发送信息。我希望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
答案 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