定期重新运行 Outlook VBA 脚本'Application_Startup'

Question

我已经(使用来自SO的信息(实现了一个VBA宏，该宏在从Outlook规则中删除"运行脚本"选项后运行以处理新电子邮件。我这样做如下：

Private WithEvents Items As Outlook.Items
Public Sub Application_Startup()
' Add an inbox event listener
  Dim olApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  ' default local Inbox
  Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
  MsgBox "Startup macro run"
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
  'Do something on new email arrival
.
.
.
End Sub

但是，收件箱侦听器似乎经常停止工作，我要么必须重新启动Outlook，要么手动重新运行"启动"宏以使其恢复生机-这似乎是一个没有解决方案的常见问题。

问题 - 我不是 VBA 专家，我想知道我是否可以简单地重新运行"Application_Startup"宏以在'Items_ItemAdd(ByVal item As Object)'宏结束时重新启动侦听器？

Answer 1

如果您需要重置ItemAdd事件处理程序，我认为使用 ItemAdd 来做到这一点没有任何意义。

您可以使用计时器(VBA 中不存在(，也可以使用一些或多或少触发频率的其他事件，例如 Explorer.SelectionChange 事件(可以从Application.ActiveExplorer中检索Explorer(。

Answer 2

您可以添加一个新宏来执行最初存在于 Application_Startup 事件中的操作。然后，您可以稍后在Items_ItemAdd宏的末尾引用该子。

Private WithEvents Items As Outlook.Items
Public Sub Application_Startup()
   Call startupevents
End Sub
Sub startupevents()
' Add an inbox event listener
  Dim olApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  ' default local Inbox
  Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
  MsgBox "Startup macro run"
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
  'Do something on new email arrival
'
'
'
Call startupevents
End Sub

Answer 3

更简单的代码可能会产生影响。

Private WithEvents Items As Outlook.Items
Public Sub Application_Startup()
    ' Add an inbox event listener
    Dim objNS As Outlook.NameSpace
    ' The code is in Outlook, not being called, for example, from Excel.
    Set objNS = Session.GetNamespace("MAPI")
    ' default local Inbox
    Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
    MsgBox "Startup macro run"
End Sub

如果上述内容没有影响，则可能会足够频繁地重新运行Application_Startup。

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