Outlook VBA 宏阻止运行指定的电子邮件帐户答案

【问题标题】：Outlook VBA Macro Prevent Running Specified Email AccountOutlook VBA 宏阻止运行指定的电子邮件帐户
【发布时间】：2018-12-03 23:06:38
【问题描述】：

我一直在使用 Office 365 Outlook 帐户。现在我配置了 3 个电子邮件帐户。因为我创建了一个 VBA 宏脚本。我不希望这个脚本在我所有的电子邮件帐户中运行。我只想在指定的帐户中运行 VBA 脚本。怎样才能做到这一点？

例如：假设我的三个帐户

test@test.com,
test1@test.com,
test2@test.com。

我只想在

中执行我的 VBA 代码

test@test.com,
test1@test.com,

没有在

处运行 VBA 脚本

test2@test.com

我的代码：-

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 strMsg As String

    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
        If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@newsdozens.com") = 0 Then
        If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@newsdozens2.com") = 0 Then
        If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@bnewstest.com") = 0 Then
            strMsg = strMsg & "   " & pa.GetProperty(PR_SMTP_ADDRESS) & vbNewLine
        End If
        End If
        End If
    Next

    If strMsg <> "" Then
        prompt = "This email will be sent outside of newsdozens.com to:" & vbNewLine & strMsg & "Do you want to proceed?"
        If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
            Cancel = True
        End If
    End If
End Sub

【问题讨论】：

您目前如何运行该宏？
请edit您的问题并添加您正在使用的代码。
是的，我已经添加了我使用的代码
你到底是什么意思？您是否只想针对特定的消息存储运行您的代码？还是仅在收到来自特定帐户的电子邮件时？或者当它使用特定帐户发送时？

标签： vba outlook office365

【解决方案1】：

要选择性地启动宏，您可以执行以下操作：

Dim Session As Outlook.NameSpace
Dim Accounts As Outlook.Accounts
Dim currentAccount As Outlook.Account

Set Session = Application.Session    
Set Accounts = Session.Accounts

For Each currentAccount In Accounts                    
    Debug.Print currentAccount.SmtpAddress

    If currentAccount.SmtpAddress <> "test2@test.com" Then
        '  call your macro
    End If
Next

【讨论】：

【解决方案2】：

有多种获取发件人信息的方法。这应该适用于 EX 或 SMTP 地址。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    Debug.Print Item.SenderEmailAddress
    ' use text from the debug.print, that is unique to the account
    If InStr(Item.SenderEmailAddress, "test2") Then Exit Sub

    ' code here for all other accounts

End Sub

【讨论】：

【解决方案3】：

您可以在 ItemSend 事件中查看发件人的电子邮件地址，如果不应该为特定帐户运行 VBA 宏，则取消任何进一步的操作：

 Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

   If InStr(LCase(Item.SenderEmailAddress), "test2@test.com") = 0 Then Exit Sub

   Dim recips As Outlook.Recipients
   Dim recip As Outlook.Recipient
   Dim pa As Outlook.PropertyAccessor
   Dim prompt As String
   Dim strMsg As String

   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
    If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@newsdozens.com") = 0 Then
    If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@newsdozens2.com") = 0 Then
    If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@bnewstest.com") = 0 Then
        strMsg = strMsg & "   " & pa.GetProperty(PR_SMTP_ADDRESS) & vbNewLine
    End If
    End If
    End If
  Next

  If strMsg <> "" Then
    prompt = "This email will be sent outside of newsdozens.com to:" & vbNewLine & strMsg & "Do you want to proceed?"
    If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
        Cancel = True
    End If
  End If
End Sub

【讨论】：