将所有Outlook子文件夹存档到另一个子文件夹

Question

下午所有时间

我的Outlook中具有以下结构：

Mapi > peter*********com > !!!INCIDENTS > !APS PV >!Archive

我想将子文件夹!APS PV中的所有子文件夹放入子文件夹!Archive中。

我的代码看起来要遍历子文件夹并移动每个子文件夹。我没有问题移动子文件夹，它将所有子文件夹加载到一个数组中。没有商品被退回。

    Dim olFolder As Outlook.MAPIFolder
    Dim SubFolder As Outlook.MAPIFolder
    Dim olNs As Outlook.NameSpace
    Dim Item As Object
    Dim lngCount As Long
    Dim Items As Outlook.Items

    On Error GoTo MsgErr
'    Set Inbox Reference
    Set olNs = Application.GetNamespace("MAPI")
    Set olFolder = olNs.GetDefaultFolder(olFolderInbox).Parent
    Set Items = olFolder.Items
    Set olFolder = olFolder.Folders("!!!INCIDENTS")
    Set Items = olFolder.Items
    Set olFolder = olFolder.Folders("!APS PV")
    Set Items = olFolder.Items

'   // Loop through the Items in the folder backwards
    For lngCount = Items.Count To 1 Step -1
        Set Item = Items(lngCount)

        Debug.Print Item.Subject

        If Item.Class = olMail Then
'           // Set SubFolder of Inbox
            Set SubFolder = olFolder.Folders("!Archive")
'           // Mark As Read
            Item.UnRead = False
'           // Move Mail Item to sub Folder
            Item.Move SubFolder
        End If
    Next lngCount

尽管存在许多子文件夹，Items.Count仍返回零。

彼得

Answer 1

您可以列出所有文件夹以查看可用的文件夹。

Option Explicit

Sub FoldersList()

    Dim olNs As NameSpace

    Dim olMailbox As Folder

    Set olNs = GetNamespace("MAPI")

    Debug.Print olNs.GetDefaultFolder(olFolderInbox).Parent
    Set olMailbox = olNs.GetDefaultFolder(olFolderInbox).Parent

    processFolder olMailbox

End Sub

Private Sub processFolder(ByVal oParent As Folder)

    Dim oFolder As Folder

    Debug.Print oParent

    If oParent = "!!!INCIDENTS" Then MsgBox "found"

    If (oParent.Folders.Count > 0) Then
        For Each oFolder In oParent.Folders
            processFolder oFolder
        Next
    End If

End Sub