Question

我试图在Outlook 2016的VBA脚本上创建以下条件。

我希望用户在向外部用户发送电子邮件时弹出确认信息。我还希望用户在向内部和外部用户发送电子邮件时弹出确认。

以下是代码，但我无法找到解决方法，因为ElseIf似乎被忽略了。

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 external = 1 Then
        prompt = "This email is being sent to External addresses. Do you still wish to send?"
        If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
            Cancel = True

        ElseIf 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 If
End Sub

Answer 1

如果外部为真，则第一个'if'将始终为true，这意味着代码永远不会到达'elseif'。

宁可做

if external + internal = 2
    ' Somethen
elseif external = 1
    ' Somethen else
end if

Answer 2

这有点简化原始代码。

我将external更改为真boolean，并使名称更加明确
一旦识别出外部地址，就会中断地址检查。
如果有外部地址，则会通过稍微更通用的消息要求确认
它不关心一个地址是外部的20内部，20外部没有内部，或其他任何东西 - 它只是寻找域外的东西＆amp;提示

我认为最后一点是您真正需要的简化。我猜没有人真正关心外部地址列表中是否包含内部地址，并且大多数人在他们多次看到该消息后不会仔细阅读以注意到这种区别。

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 hasExternalAddress As Boolean

  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
      external = True
      Exit For
    End If
  Next

  If hasExternalAddress Then
    prompt = "This email includes an 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 3

遵循正确的代码

   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 Boolean
    Dim external As Boolean

    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 = True
        If str1 <> strMyDomain Then external = True
    Next

    If external And Not internal Then
        prompt = "This email is being sent to External addresses. Do you still wish to send?"
        If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
            Cancel = True
        End If
    ElseIf internal And external 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

这很有效，可以满足我需要的所有选项。修改了bolean中的字符串。感谢大家的支持。

Answer 4

在不辩论True False是否更好/更直观的情况下，您开始使用的代码可以使用1和2而不是1和1。

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
        If str1 <> strMyDomain Then external = 2

    Next

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

        ElseIf internal + external = 3 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 If
End Sub

VBA脚本IF ELSEIF检查外部和内部

4 个答案: