vba - 将 NDR 邮件移动到不在收件箱中的文件夹

Question

我想将 NDR 邮件移动到不在收件箱中的文件夹。

我在网上找到了可以移动 NDR 但不是我想要的地方的工作代码。我认为问题出在路径上：

Set Folders = Session.GetDefaultFolder(olFolderInbox).Folders
Set Folder = Folders.Item("NDR")

如何将 NDR 移动到“x_spam”中的“nem_kezbesitheto”子文件夹？

Outlook 文件夹结构

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
    Set Items = Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
    On Error Resume Next

    If UCase(Item.MessageClass) = "REPORT.IPM.NOTE.NDR" Then
        Set Folders = Session.GetDefaultFolder(olFolderInbox).Folders
        Set Folder = Folders.Item("NDR")
        If Folder Is Nothing Then
            Folder = Folders.Add("NDR")
        End If
        Item.Move Folder
    End If
End Sub

标签： vbaoutlook

Answer 1

目标文件夹似乎位于单独的商店中。使用NameSpace.Stores属性，该属性返回代表当前配置文件中Stores所有对象的集合对象。Store例如：

Sub EnumerateFoldersInStores() 
 Dim colStores As Outlook.Stores
 Dim oStore As Outlook.Store 
 Dim oRoot As Outlook.Folder 
 
 On Error Resume Next 
 
 Set colStores = Application.Session.Stores
 For Each oStore In colStores 
   Set oRoot = oStore.GetRootFolder 
   Debug.Print (oRoot.FolderPath) 
     EnumerateFolders oRoot 
 Next 
 
End Sub 
 
Private Sub EnumerateFolders(ByVal oFolder As Outlook.Folder)
 Dim folders As Outlook.folders 
 Dim Folder As Outlook.Folder 
 Dim foldercount As Integer 
 
 On Error Resume Next 
 
 Set folders = oFolder.folders 
 foldercount = folders.Count 
 'Check if there are any folders below oFolder 
 
 If foldercount Then 
   For Each Folder In folders
     Debug.Print (Folder.FolderPath) 
 
     EnumerateFolders Folder 
 
   Next 
 End If
End Sub

因此，不要使用以下代码行：

Session.GetDefaultFolder(olFolderInbox).Folders

您将不得不使用以下一个：

Store.GetDefaultFolder(olFolderInbox).Folders

对象store代表目标商店的位置。您必须使用Stores从类的相应属性返回的集合来找到它Namespace。