收听多个项目被拖到一个文件夹-Outlook

Question

我正试图找出如何通过在文件夹上放置侦听器来跟踪进入文件夹的邮件项目的数量，但它无法正常工作。这就是我所拥有的，但由于某种原因，当我将多封电子邮件拖到该文件夹时，所选的金额不正确。基本上，我想对文件夹做的是将拖到文件夹中的所有邮件项目的名称更改为相同的名称。所以我需要有一种方法来引用那些被拖进来的项目。我想我可以通过使用Selection来做到这一点，但我不确定。有什么想法吗？？非常感谢。这是我的代码：

Private WithEvents MatchTicketNumberItems As Outlook.Items
Private Sub Application_Startup()
  Dim olApp As Outlook.Application
  Dim objNS As Outlook.NameSpace
  Set olApp = Outlook.Application
  Set objNS = olApp.GetNamespace("MAPI")
  'Specify folders that will have listeners on them
  Set MatchTicketNumberItems = objNS.GetDefaultFolder(olFolderInbox).Parent.Folders("MatchTicketNumber").Items
End Sub
Private Sub MatchTicketNumberItems_ItemAdd(ByVal item As Object)
   Dim selected As Integer
   Dim objSelection As Outlook.Selection
   Set objSelection = Application.ActiveExplorer.Selection
   selected = objSelection.count
   'Do stuff
End Sub

Answer 1

请记住，MAPI事件仅用于UI目的，在重载情况下可以（并且可以）跳过。

话虽如此，你能更具体一点吗？您拖动了多少项，事件处理程序激发了多少次？

此外，您为什么使用Explorer.Selection？如果项目是直接创建的，则当前选择将不相关。

Answer 2

前面的答案解决了这个问题，但您可以尝试这种方式，自动移动到MatchTicketNumber文件夹。

Private Sub MatchTicketNumberItems_ItemAdd(ByVal item As Object)
   Dim objNS As Outlook.Namespace
   Dim i As Long
   ' Do Stuff
   item.Save    
End Sub

Sub Process_Selection_Multiple_MatchTicketNumber()     
    Dim objNS As Outlook.Namespace
    Dim targetFolder As MAPIFolder
    Dim selectionIndex As Long
    Dim itm As Object
    Set objNS = Application.GetNamespace("MAPI")
    Set targetFolder = objNS.GetDefaultFolder(olFolderInbox).Parent.Folders("MatchTicketNumber")
    For selectionIndex = 1 To ActiveExplorer.Selection.count
        Set itm = ActiveExplorer.Selection(selectionIndex)
       itm.Move targetFolder
    Next
End Sub