Question

我一直在使用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

Answer 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

Answer 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

Answer 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

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

3 个答案: