☰

Outlook 空白主题导致规则崩溃...要解析的 VBA 未显示在脚本列表中

tag-icon • tag-icon microsoft-outlook vba macros
Outlook 空白主题导致规则崩溃...要解析的 VBA 未显示在脚本列表中

因此，Outlook 中存在一个已知的错误，其中 IMAP&SMTP 帐户的传入规则中的空白主题行导致转发规则出错并崩溃，并最终禁用该规则。

我认为解决这个问题的一种方法是编写一个 VBA 将字符串附加到主题行，这样空白主题行至少会包含附加的字符串。

Sub myRuleMacro()
Dim xItem As Object
Dim xNewSubject As String
Dim xMailItem As MailItem
Dim xExplorer As Explorer
Dim i As Integer
On Error Resume Next
Set xExplorer = Outlook.Application.ActiveExplorer
For i = xExplorer.Selection.Count To 1 Step -1
    Set xItem = xExplorer.Selection.item(i)
    If xItem.Class = olMail Then
        Set xMailItem = xItem
        With xMailItem
            xNewSubject = "RE: " & .Subject
            .Subject = xNewSubject
            .Save
        End With
    End If
Next
End Sub

手动运行时，此功能非常有效，但它不会出现在规则内的脚本列表中。

空白脚本列表

看了其他帖子，第一行应该是

Sub myRuleMacro(item as Outlook.MailItem)

并在括号中添加位。然而，虽然这随后出现在我的 Outlook 规则中的脚本列表中，但尝试手动运行 VBA 或逐步执行时，我得到的结果是，好像宏不存在一样

使用 F5 运行时出错的照片

对我哪里做错了有什么想法吗？

谢谢

答案1

要使 VBA 过程显示为宏，它需要：

  1. 是Public（这是默认设置，因此您在这里很好）
  2. 没有强制参数（这就是你出错的地方）

您不需要将其显示为宏即可使其工作。如果您想测试它，您需要一个像这样的辅助子程序：

Public Sub testMyRuleMacro()
    Dim CurrentMessage As MailItem
    Dim SelectedItems As Selection
    Set SelectedItems = Outlook.ActiveExplorer.Selection
    For Each CurrentMessage In SelectedItems
        myRuleMacro CurrentMessage
    Next CurrentMessage
End Sub

最后，看起来您正在尝试运行规则来修复规则。这听起来像是灾难的根源。我建议您使用 VBA 事件来运行代码来修复规则，以便规则可以运行。

要做到这一点，您需要将事件过程放入ThisOutlookSessionOutlook 应用程序本身的内置模块中。这是 Outlook 存储其所有事件过程的地方。

你看起来会像这样：

Option Explicit
Private WithEvents inboxItems As Outlook.Items
    
' Set up the listener on the Inbox
Private Sub Application_Startup()
    Dim outlookApp As Outlook.Application
    Dim objectNS As Outlook.NameSpace
      
    Set outlookApp = Outlook.Application
    Set objectNS = outlookApp.GetNamespace("MAPI")
    Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub

' This runs for each item added to the inbox
Private Sub InboxItems_ItemAdd(ByVal Item As Object)
    If TypeName(Item) = "MailItem" Then
        Dim EMail As Outlook.MailItem
        Set EMail = Item
   
        Debug.Print "Incoming Data."
        myRuleMacro EMail

        Set EMail = Nothing
    End If
End Sub

这InboxItems_ItemAdd是每次对象进入收件箱时都会触发的事件。并非所有 Outlook 对象都是邮件，因此我们会对此进行测试，以排除会导致代码出现错误的情况（这些错误会导致邮件出现）。

相关内容