Question

我目前正在使用以下代码来重新计算Outlook中每个类别中的电子邮件数量（代码在Excel中）。但是，它没有考虑任何子文件夹。你能帮我改变挑选文件夹以选择任何子文件夹吗？

Sub test()
Dim oDict As Scripting.Dictionary
Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder

Dim olItem As Object
Dim arrData() As Variant
Dim CategoryCnt As Integer
Dim c As Long

On Error Resume Next

Set oDict = New Scripting.Dictionary

Set olApp = New Outlook.Application

Set olNs = olApp.GetNamespace("MAPI")

Set olFolder = olNs.Session.PickFolder()

'Set olFolder = olNS.GetDefaultFolder(olFolderInbox)

CategoryCnt = olNs.Categories.Count



ReDim arrData(1 To 2, 1 To CategoryCnt)

c = 0
For Each olItem In olFolder.Items
    If Not oDict.Exists(olItem.Categories) Then
        c = c + 1
        arrData(1, c) = olItem.Categories
        arrData(2, c) = 1
        oDict.Add olItem.Categories, c
    Else
        arrData(2, oDict.Item(olItem.Categories)) = arrData(2, oDict.Item(olItem.Categories)) + 1
    End If
Next olItem

ReDim Preserve arrData(1 To 2, 1 To c)

Range("A2").Resize(UBound(arrData, 2), UBound(arrData, 1)).Value = Application.Transpose(arrData)

MsgBox ("Done")

End Sub

干杯，

Answer 1

Sub Folder_Picker()

    'Needs reference to MS Outlook Object Library

    Dim olApp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim olParentFolder As Outlook.MAPIFolder
    Dim olFolderA As Outlook.MAPIFolder
    Dim olFolderB As Outlook.MAPIFolder

    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
Dim Folder_name(100, 100) As String

Dim folder_count(100, 100) As String
     i = 1
     j = 1

Set olParentFolder = olNs.Session.PickFolder()

    For Each olFolderA In olParentFolder.Folders
        'Debug.Print olFolderA.folderPath, olFolderA.Items.Count, olFolderA.Folders.Count

         Folder_name(i, j) = olFolderA.folderPath
        folder_count(i, j) = olFolderA.Folders.Count

         j = j + 1
        For Each olFolderB In olFolderA.Folders
           ' Debug.Print olFolderB.folderPath, olFolderB.Items.Count

        Folder_name(i, j) = olFolderA.folderPath
        folder_count(i, j) = olFolderA.Folders.Count

         j = j + 1

        Next
        j = 1
        i = i + 1
    Next

End Sub

Answer 2

无法自定义PickFolder对话框以支持已检查的树形列表项（Redemption虽然具有此功能）。

此外，如果您要处理来自任何给定文件夹的所有子文件夹，您需要递归地执行此操作以确保您在子文件夹级别一直获得子项的子项，如下所示：

Sub ProcessFolderCaller()
     Dim objInbox As Folder

     Set objInbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
     ProcessFolder objInbox
End Sub

Sub ProcessFolder(objFolder As Folder)
     Dim intX As Integer
     Dim objSubFolders As Folders

     Debug.Print "Processing folder '" & objFolder.Name & "'..."

     Set objSubFolders = objFolder.Folders

     For intX = 1 To objSubFolders.Count
         Dim objSubjFolderA As Folder
         Set objSubjFolderA = objSubFolders.Item(intX)
         ProcessFolder objSubjFolderA
     Next
 End Sub

Outlook VBA Pickfolder命令包含子文件夹

2 个答案: