在本地域之外发送邮件时发出警告

时间:2014-12-03 02:05:09

标签: vba outlook

我有以下代码检查您发送的电子邮件是否在我们的本地域内,如果不是,则会提示您是/否确认。

我想更改此内容以检查一些内部的其他域名,以便它不会提示这些域名的消息。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim recips As Outlook.Recipients
Dim recip As Outlook.Recipient
Dim pa As Outlook.PropertyAccessor
Dim prompt As String
Dim strMsg As String

Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

Set recips = Item.Recipients
For Each recip In recips
Set pa = recip.PropertyAccessor
If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@domain.com.au") = 0 Then
strMsg = strMsg & "   " & pa.GetProperty(PR_SMTP_ADDRESS) & vbNewLine
End If
Next
For Each recip In recips
Set pa = recip.PropertyAccessor
If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@domain.com.au") = 0 Then
prompt = "This email will be sent outside of domain.com.au to:" & vbNewLine & strMsg & "Do you want to proceed?"
If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
    Cancel = True
    Exit Sub
Else
    Exit Sub
End If
End If
Next
End Sub

1 个答案:

答案 0 :(得分:0)

通过简单的AND条件解决。

If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@domain.com.au") = 0 AND InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@domaintwo.com.au") Then