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

m0b1l3us3r

我正在尝试在适用于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
m0b1l3us3r

遵循正确的代码

   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中修改了字符串。感谢大家的支持。

本文收集自互联网,转载请注明来源。

如有侵权,请联系 [email protected] 删除。

编辑于
0

我来说两句

0 条评论
登录 后参与评论

相关文章