将具有特定主题的 Outlook 邮件移动到子文件夹答案

【问题标题】：Moving Outlook message with specific subject to Subfolders将具有特定主题的 Outlook 邮件移动到子文件夹
【发布时间】：2015-01-20 17:56:05
【问题描述】：

我正在尝试编写一个简短的 VBA 脚本，它将传入的邮件从我的 Outlook 收件箱移动到一个子文件夹。这是我目前拥有的（从各种帖子中收集），但是当我发送测试电子邮件时我没有得到任何结果。如果有其他与此相关的帖子，我将不胜感激！

Private Sub Application_Startup()
  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
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)

  On Error GoTo ErrorHandler
  Dim Msg As Outlook.MailItem
  Set myInbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
  If TypeName(item) = "MailItem" Then
    Set Msg = item

    If Msg.SenderEmailAddress = "name@example.com" Then
        If InStr(0, Msg.Subject, "Subject Title", vbTextCompare) > 0 Then
        Msg.Move myInbox.Folders("Test").Subfolder("Destination")
        End If
    End If

  End If
ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub

【问题讨论】：

标签： vba outlook subdirectory inbox

【解决方案1】：

看起来您没有正确定义和初始化 Items 对象。例如：

 Public WithEvents myOlItems As Outlook.Items

 Public Sub Initialize_handler()  
     Set myOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Items  
 End Sub 

 Private Sub myOlItems_ItemAdd(ByVal Item As Object)  
    ' do something here
 End Sub

请注意，当同时添加超过 16 个项目时，不会触发 ItemAdd 事件。这是 OOM 中的一个已知问题。

尝试改用 Application 类的 NewMailEx 事件。我建议阅读以下系列文章：

最后，您的宏在 Outlook 中启用了吗？您检查过信任中心设置吗？

【讨论】：

好吧，我也更新了帖子。请参阅上面的更改。
感谢您的建议！我的宏已启用，我将尝试使用 NewMailEx 应用程序。但是，目前我仍然没有从当前的宏中得到任何响应——当测试电子邮件通过时我什至没有收到通知（即没有错误）。有什么想法吗？
您是否查看了 Outlook 中的信任中心设置？您的宏是否允许运行？
我将信任中心内的宏设置更改为“启用所有宏”。我相信这是运行宏的唯一相关设置，对吗？

【解决方案2】：

将您的代码放入 ThisOutlookSession。

就在你的代码上面放

Public WithEvents Items As Items

使用内置类模块 ThisOutlookSession 时，Sub Application_Startup() 会初始化处理程序。

【讨论】：