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

3 回答

• 0

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

  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
  

  回复于 2024-04-29T11:59:17+08:00
• 0

  有多种获取发件人信息的方法。这应该适用于 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
  

  回复于 2024-04-29T11:59:17+08:00
• 0

  如果不需要为特定帐户运行 VBA 宏，则可以在ItemSend事件中检出发件人的电子邮件地址，并取消其他任何操作：

  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
  

  回复于 2024-04-29T11:59:17+08:00