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

时间:2016-07-25 20:43:57

标签: vba email outlook outlook-vba

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

文件夹结构如下

myarchive-mailbox name
Inbox Main folder
  requests Sub folder

myarchive
   Inbox
      requests 

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

我已经实现了将文件从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

2 个答案:

答案 0 :(得分: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

答案 1 :(得分:1)

假设您要将其移至主默认收件箱,请尝试以下代码

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