Предупреждать перед отправкой сообщений за пределы нескольких возможных внутренних доменов? - PullRequest
Новая
       14

Предупреждать перед отправкой сообщений за пределы нескольких возможных внутренних доменов?

0 голосов
/ 04 июля 2018

Я пытаюсь проверить, есть ли получатели моей электронной почты в нашем глобальном списке адресов в Outlook 2016.

Если все получатели являются внутренними (наш глобальный список адресов включает только внутренние адреса), сообщение освобождается.

Если хотя бы один из получателей является внешним (из-за пределов GAL), я должен получить предупреждающее сообщение, которое спросит, хочу ли я по-прежнему отправлять это электронное письмо.

Я пробовал эту тему, но мне нужно решение без копирования адресов во внешнюю электронную таблицу Excel.

Я также работал с этим решением, но наша компания большая и имеет несколько филиалов по всему миру. Приведенное решение проверяет, совпадает ли мой домен с доменами получателей. Проблема возникает, когда я пытаюсь отправить электронное письмо людям из моей компании, но за пределами моего региона - я из EMEA, и, например, Я отправляю электронное письмо в PAM. К сожалению, этого решения недостаточно в данный момент. Поскольку PAM использует другой домен - появляется предупреждение.

Самым простым способом для меня было бы проверить получателей в GAL, но я не уверен, возможно ли это вообще.

Код из второго решения ниже: 

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 Address As String
 Dim lLen
 Dim strMyDomain
 Dim internal As Long
 Dim external As Long

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

' non-exchange
' userAddress = Session.CurrentUser.Address
' use for exchange accounts
userAddress = Session.CurrentUser.AddressEntry.GetExchangeUser.PrimarySmtpAddress
lLen = Len(userAddress) - InStrRev(userAddress, "@")
strMyDomain = Right(userAddress, lLen)

Set recips = Item.Recipients
 For Each recip In recips
 Set pa = recip.propertyAccessor

Address = LCase(pa.GetProperty(PR_SMTP_ADDRESS))
 lLen = Len(Address) - InStrRev(Address, "@")
str1 = Right(Address, lLen)

  If str1 = strMyDomain Then internal = 1
  If str1 <> strMyDomain Then external = 1
Next

 If internal + external = 2 Then
prompt = "This email is being sent to Internal and External addresses. Do you still wish to send?"

 If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
    Cancel = True
 End If

End If

End Sub

1 Ответ

0 голосов
/ 04 июля 2018

Вы можете заменить один внутренний домен массивом доменов. 

Option Explicit

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

    Dim recips As Recipients
    Dim recip As Recipient

    Dim pa As propertyAccessor

    Dim prompt As String
    Dim Address As String

    Dim lLen As Long
    Dim Str1 As String

    Dim arrayDomains() As Variant
    Dim i As Long

    Dim internalFlag As Boolean
    Dim externalFlag As Boolean

    Dim strExtAdd As String

    arrayDomains = Array("PAM domain", "EMEA domain", "other internal domain")

    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

        Address = LCase(pa.GetProperty(PR_SMTP_ADDRESS))
        lLen = Len(Address) - InStrRev(Address, "@")
        Str1 = Right(Address, lLen)

        internalFlag = False

        For i = LBound(arrayDomains) To UBound(arrayDomains)
            If Str1 = arrayDomains(i) Then
                internalFlag = True
                Exit For
            End If
        Next

        If internalFlag = False Then
            externalFlag = True
            strExtAdd = strExtAdd & vbCr & Address
        End If

    Next

    If externalFlag = True Then

        prompt = "This email is being sent to external addresses. Do you still wish to send?" & strExtAdd
        If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
            Cancel = True
        End If

    'Else

        'Debug.Print "Internal addresses only."

    End If

End Sub
...