0
我有以下代碼，用於檢查您發送的電子郵件是否位於本地域內，如果不是，它會提示您是/否確認。在本地域以外發送郵件時發出警告
我想改變這個來檢查一些額外的域也是內部的，所以它不會提示這些域的消息。
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