运行宏的“仅在此计算机上”的收件箱规则定期失败

Question

我有一个收件箱规则，当消息“仅在此计算机上”到达时运行，该规则执行宏。

宏从发件人的电子邮件地址中提取域。它还会将内部用户的 Exchange 电子邮件覆盖为“Exchange”。

这允许我在收件箱中拥有一个包含电子邮件发件人域的自定义字段。我用它来做很多事情，包括排序、分类等。

它会定期失败。我需要捕获更多关于什么消息导致它无法找到模式以及可能的修复的信息。

Public Sub ExtractDomain(Item As Outlook.MailItem)

  Dim oProp As Outlook.UserProperty
  Dim sDomain

  sDomain = Right(Item.SenderEmailAddress, Len(Item.SenderEmailAddress) - InStr(1,Item.SenderEmailAddress, "@"))
  If Item.SenderEmailType = "EX" Then sDomain = "Exchange"
  Set oProp = Item.UserProperties.Add("Domain", olText, True)
  oProp.Value = sDomain
  Item.Save
  If Err.Number <> 0 Then
    MsgBox Err.Description
  End If
  Err.Clear

End Sub

当它失败时，我进入规则，编辑规则，不做任何更改，但再次保存它，重新启用它，然后它运行到下一次。

我删除了

On Error ResumeE Next

并添加了错误的 MsgBox。我也得到了同样的东西。标题为“规则错误”的对话框，其中有两列“规则”和“错误”，分别显示“提取域”和“操作失败”。

我还被告知有一种更好的方法来识别 Exchange 电子邮件，因此我不再解析从

sDomain

解析的

SenderEmailAddress

值。我正在使用这个：

If oMail.SenderEmailType = "EX" Then sDomain = "Exchange"

上面的代码经过编辑以反映当前正在运行的内容。

我一直在监视我的收件箱以捕获失败的情况，并且有两个示例，都是 Internet 电子邮件地址，而不是 Exchange 电子邮件地址。我查看了电子邮件互联网标头，并尝试查看发件人信息是否存在问题。目前尚不清楚 Outlook 从哪里获取我正在解析的 SenderEmailAddress，但我怀疑它是 SMTP“From:”值。其中一条失败消息来自 Microsoft，并显示此值：

发件人：“[电子邮件受保护]”[电子邮件受保护]

我添加了一个临时宏来提取域并填充一封或多封选定电子邮件的用户属性，并且它适用于在收件箱规则执行上述代码时触发错误的同一电子邮件。另一个宏如下所示：

Sub ListSelectionDomain()
  Dim aObj As Object
  Dim oProp As Outlook.UserProperty
  Dim sDomain
  For Each aObj In Application.ActiveExplorer.Selection
    Set oMail = aObj
    sDomain = Right(oMail.SenderEmailAddress, Len(oMail.SenderEmailAddress) - InStr(1, oMail.SenderEmailAddress, "@"))
    If oMail.SenderEmailType = "EX" Then sDomain = "Exchange"
    Set oProp = oMail.UserProperties.Add("Domain", olText, True)
    oProp.Value = sDomain
    oMail.Save
    If Err.Number <> 0 Then
      MsgBox Err.Description
    End If
    Err.Clear
  Next
End Sub

Answer 1

尝试删除

On Error Resume Next

，看看是否会出现更好的错误。或者实际显示错误：

Public Sub ExtractDomain(Item As Outlook.MailItem)

  Dim oProp As Outlook.UserProperty
  Dim sDomain
  On Error Resume Next

  sDomain = Right(Item.SenderEmailAddress, Len(Item.SenderEmailAddress) - InStr(1,Item.SenderEmailAddress, "@"))
  If Left(sDomain, 66) = "/O=EXCHANGELABS/OU=EXCHANGE ADMINISTRATIVE GROUP (xxxxxxxxxxxxx)" Then sDomain = "Exchange"
  Set oProp = Item.UserProperties.Add("Domain", olText, True)
  oProp.Value = sDomain
  Item.Save
  if Err.Number <> 0 Then
    MsgBox Err.Description
  End If
  Err.Clear

End Sub

我怀疑您在添加用户属性时遇到错误。