Сценарий VBA, ЕСЛИ ELSEIF проверить, если внешний и внутренний - PullRequest
0 голосов
/ 31 мая 2018

Я пытаюсь выполнить следующие условия для сценария VBA для Outlook 2016.

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

Ниже приведен код, но я не могу выяснить, как это исправить, поскольку 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

Ответы [ 4 ]

0 голосов
/ 01 июня 2018

Не обсуждая, является ли 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
0 голосов
/ 31 мая 2018

Это немного упрощает ваш оригинальный код.

  • Я изменил external на истинное boolean и сделал имя немного более явным
  • Он прекращает проверку адреса, как только идентифицирует внешний адрес.
  • Если есть внешний адрес, он запрашивает подтверждение с немного более общим сообщением
  • Не имеет значения, является ли один адрес внешним с 20 внутренними, 20 внешними без внутреннего иличто-нибудь еще - он просто ищет что-то за пределами домена и подсказывает

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

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

Посмотрим, сработает ли это для вас.

0 голосов
/ 01 июня 2018

После правильного кода

   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

Это прекрасно работает и соответствует всем параметрам, которые мне нужны.Модифицированная строка в боле.Спасибо всем за поддержку.

0 голосов
/ 31 мая 2018

Если значение external равно true, первое 'if' всегда будет истинно, что означает, что код никогда не попадет в 'elseif'.

Скорее выполните

if external + internal = 2
    ' Somethen
elseif external = 1
    ' Somethen else
end if
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...