如何引用搜索文件夹?

How to reference a search folder?

我们在 Excel 中使用 VBA 宏来计算多个 Outlook 子文件夹中的邮件数量。 我也想用它来计算搜索文件夹中的邮件数量,但它不起作用。

代码循环遍历不同的 Outlook 文件夹,每个文件夹的位置在 Excel sheet 的列中可用。 (mailbox@mail.com\folder\subfolder - 具有不同的邮箱/文件夹可能性)。

我们用下面的代码引用这个文件夹:

set mailfolder = GetFolder(email_folder)

这是 GetFolder 函数:

Function GetFolder(ByVal strFolderPath As String) As MAPIFolder
    '    strFolderPath needs to be something like
    '    "Public Folders\All Public Folders\Company\Sales" or
    '    "Personal Folders\Inbox\My Folder"
    
    Dim objApp As Outlook.Application
    Dim objNS As Outlook.Namespace
    Dim colFolders As Outlook.Folders
    Dim objFolder As Outlook.MAPIFolder
    Dim arrFolders() As String
    Dim i As Long
        
    On Error Resume Next
        
    'strFolderPath = Replace(strFolderPath, "/", "\")
    arrFolders() = Split(strFolderPath, "\")
    Set objApp = CreateObject("Outlook.Application")
    Set objNS = objApp.GetNamespace("MAPI")
    Set objFolder = objNS.Folders.Item(arrFolders(0))
    If Not objFolder Is Nothing Then
        For i = 1 To UBound(arrFolders)
            Set colFolders = objFolder.Folders
            Set objFolder = Nothing
            Set objFolder = colFolders.Item(arrFolders(i))
            If objFolder Is Nothing Then
                Exit For
            End If
        Next
    End If
        
    Set GetFolder = objFolder
    Set colFolders = Nothing
    Set objNS = Nothing
    Set objApp = Nothing
        
    On Error GoTo 0
    
End Function

有没有办法调整此功能以查找搜索文件夹?

使用文件夹名称。没有路径。

Private Sub Test_Unread()
    FindSearchFolder "Unread Mail"
End Sub

Private Sub FindSearchFolder(fldrName As String)

    Debug.Print
    Debug.Print "Searching for " & fldrName
    
    Dim objStores As Stores
    Dim objStore As Store
        
    Dim objSearchFolders As folders
    Dim objSearchFolder As folder
    
    Dim objItem As Object
    
    Dim bFound As Boolean
    Dim i As Long
    
    Set objStores = Session.Stores
            
    For Each objStore In objStores
    
        Debug.Print
        Debug.Print "objStore: " & objStore
        
        bFound = False
        
        Set objSearchFolders = objStore.GetSearchFolders
        
        For Each objSearchFolder In objSearchFolders
        
            Debug.Print " objSearchFolder: " & objSearchFolder
            
            If objSearchFolder.name = fldrName Then
            
                Debug.Print " Found in " & objStore
                bFound = True
                
                Set ActiveExplorer.CurrentFolder = objSearchFolder
                Debug.Print objSearchFolder.Items.count
                
            End If
            
            If bFound = True Then Exit For
            
        Next
        
        If bFound = False Then Debug.Print " Not found in " & objStore
    Next
    
End Sub

如果您发现 unfixable/unexplainable 的错误,当 testing/manipulating 搜索文件夹时,关闭 Outlook 并重新启动。