在将邮件从子文件夹移动到收件箱时捕获事件答案

【问题标题】：Capture the event while moving the mail from subfolder to inbox在将邮件从子文件夹移动到收件箱时捕获事件
【发布时间】：2016-07-25 20:43:57
【问题描述】：

我需要在邮件从子文件夹移动到收件箱时捕获事件

文件夹结构如下

myarchive-mailbox name
Inbox Main folder
  requests Sub folder

myarchive
   Inbox
      requests

当电子邮件从请求子文件夹移动到收件箱时，myarchive 邮箱名称，应捕获此邮箱项目并调用事件处理程序。

我已经实现了文件从我的归档收件箱移动到请求时捕获事件的代码。我编写的代码如下

Private WithEvents Items As Outlook.Events

Private Sub Application_Startup()

    Dim olApp As Outlook.Application
    Dim objFolder As Outlook.MAPIFolder
    Dim objNs As Outlook.NameSpace

    Set olApp =Outlook.Application
    Set objNS =olApp.GetNamespace("MAPI")
    Set objFolder = objNS.Folders("myarchive")
    Set objFolder=objFolder.Folders("Inbox")
    Set Items=objFolder. Folders("requests").Items 
End Sub

Private Sub Items_ItemsAdd(ByVal item As Object)
  MsgBox "You moved the mail to requests folder"
End Sub

【问题讨论】：

Private WithEvents Items As Outlook.Events 行在我的 Outlook (2010) 版本中不起作用。
哪个收件箱？默认收件箱还是 myarchive 收件箱？
它到 myarchive 收件箱。应该捕获从 myarchive 收件箱到请求，然后从请求到 myarchive 收件箱时的事件。下面的代码工作正常，非常感谢，Om3r :)
stackoverflow.com/tour

标签： vba email outlook

【解决方案1】：

Folder 对象有一个BeforeItemMove 事件。在 ThisOutlookSession 模块中，声明一个文件夹对象 WithEvents 以公开其事件。

Private WithEvents mArchReqs As Folder

Public Property Set ArchReqs(olFldr As Folder)
    Set mArchReqs = olFldr
End Property

Public Property Get ArchReqs() As Folder
    Set ArchReqs = mArchReqs
End Property

接下来，您已经设置了要观看的文件夹。这里我设置了应用程序启动时的文件夹。

Private Sub Application_Startup()

    Set Me.ArchReqs = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("requests")

End Sub

最后，您可以编写BeforeItemMove 事件过程。

Private Sub mArchReqs_BeforeItemMove(ByVal Item As Object, ByVal MoveTo As MAPIFolder, Cancel As Boolean)

    Debug.Print Item.Subject
    Debug.Print MoveTo.Name

End Sub

【讨论】：

非常感谢迪克！！
嗨迪克，我现在已经添加了我之前实现的用于从收件箱中捕获事件到我的存档子文件夹的代码。我在我的代码中使用了 BeforeItemMove 子例程，但我没有成功集成 BeforeItemMove 子例程。Kindly帮我解决这个问题。

【解决方案2】：

假设您将其移动到主默认收件箱，然后尝试以下代码

Dim WithEvents SubFolder As Outlook.Folder
Dim Inbox As Outlook.Folder
Dim olNs As Outlook.NameSpace

Private Sub Application_Startup()
    Set olNs = Application.GetNamespace("MAPI")
    Set SubFolder = olNs.Folders("myarchive").Folders("Inbox").Folders("requests")                                                
    Set Inbox = Application.Session.GetDefaultFolder(olFolderInbox)
End Sub

Private Sub SubFolder_BeforeItemMove(ByVal Item As Object, ByVal MoveTo As MAPIFolder, Cancel As Boolean)
    If MoveTo = Inbox Then
        MsgBox Item.Subject & " was moved to Inbox"
    End If

End Sub

否则更改此行

Set Inbox = Application.Session.GetDefaultFolder(olFolderInbox)

到这里

Set Inbox = olNs.Folders("myarchive").Folders("Inbox")

Folder.BeforeItemMove Event

【讨论】：