Question

我正在尝试检查电子邮件的收件人是否在Outlook 2016的全局地址列表中。

如果所有收件人都是内部收件人（我们的GAL仅包含内部地址），则该消息将被释放。

如果至少有一个收件人是外部收件人（来自GAL之外），那么我应该收到一条警告消息，询问我是否仍要发送此电子邮件。

我尝试过this主题，但是我需要一个解决方案而不将地址复制到外部Excel电子表格中。

我也使用this解决方案，但我们的公司规模很大，并且在全球设有多个分支机构。引用的解决方案检查我的域与收件人域是否相同。当我尝试向公司的员工发送电子邮件时，会出现问题，但我所在的地区以外-我来自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

Answer 1

您可以用一组域替换单个内部域。

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

在发送多个可能的内部域之外的消息之前发出警告？

1 个答案: