VBA script IF ELSEIF check if external and internal

问题

I'm trying to make the following conditions on a VBA Script for Outlook 2016.

I want users to have a pop up for confirmation when they are sending emails to external users. I also want user to have a pop up confirmation when they are sending email to internal and external users.

Following is the code, but I cant find out how to fix this, because the ElseIf seems to be ignored.

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

回答1:

If the external is true the first 'if' will always be true, which means the code will never get to the 'elseif'.

Rather do

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

回答2:

This is a bit of a simplification of your original code.

I changed the external to a true boolean and made the name a bit more explicit
It breaks out of the address checking as soon as it identifies an external address.
If there is an external address, it asks for confirmation with a slightly more generic message
It doesn't care whether one address is external with 20 internal, 20 external with no internal, or anything else - it just looks for something outside the domain & prompts

I think that the last point is the simplification that you really need. I'd guess that nobody really cares that much whether there are internal addresses included with the list of external addresses, and most people won't read closely enough to notice the distinction after they've seen the message more than once.

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

See if that'll work for you.

回答3:

Following the correct code

   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

This works great and match all the options i need. Modified the string in bolean. Thanks everyone for the support.

回答4:

Without debating whether True False is better / more intuitive, the code you started with can work with 1 and 2 rather than 1 and 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

来源：https://stackoverflow.com/questions/50629089/vba-script-if-elseif-check-if-external-and-internal

标签

vba

outlook