使用AdvancedSearch方法查找整个邮箱

Question

我正试图从Excel中查看所有Outlook文件夹中与某些参数匹配的邮件，以保存附件。

我不知道如何引用作用域来遍历所有文件夹，甚至是自定义文件夹。

我找不到能回答我问题的资料。

Sub testing()
Dim myOlApp As New Outlook.Application
Dim scope As String
Dim filter As String
Dim rsts As Results
Dim AdvancedSearch As Outlook.Search
blnSearchComp = False
'I want it to search the entire mail account including normal folders like inbox and sent as well as custom folders.
'but this doesn't work. Any ideas?
scope = "'[e-mail]'"
'filter assignment statement has been excluded
Set AdvancedSearch = myOlApp.AdvancedSearch(scope, filter, True, "test")  
While blnSearchComp <> True
    If AdvancedSearch.Results.Count > 0 Then
        blnSearchComp = True
    End If
Wend
Set rsts = AdvancedSearch.Results
For x = rsts.Count To 1 Step -1
    rsts.Attachment.Item(x).SaveAsFile Project
Next
End Sub

Answer 1

范围应为

'\[e-mail]'

Sub Demo_scopeformat()
Dim myOlApp As New outlook.Application
Dim scope As String
' Mailbox
scope = "'" & myOlApp.Session.GetDefaultFolder(olFolderInbox).Parent.folderPath & "'"
' Expected format
Debug.Print scope
End Sub

Answer 2

好吧，我知道这不是最好的解决方案，但我已经提出了以下代码来创建所有父文件夹的列表，以便for循环可以与高级搜索方法一起使用来迭代列表。这不是最快的代码，但也不应该太慢。

Sub main()
'establishes connections
Dim myOlApp As New Outlook.Application
Dim objNS As Outlook.Namespace
Dim myFolder As Outlook.MAPIFolder
Set objNS = myOlApp.GetNamespace("MAPI")
'pick highest folder level as original my folder
Set myFolder = objNS.Folders("[e-mail]")
Call ProcessFolders(myFolder)
End Sub
Sub ProcessFolders(myFolder)
're establish connections
Dim myOlApp As New Outlook.Application
Dim objNS As Outlook.Namespace
Dim objFolder As Outlook.MAPIFolder
Set objNS = myOlApp.GetNamespace("MAPI")
'set up collection
Set x = New Collection
For Each objFolder In myFolder.Folders
'add all parent folder names to collection
'advanced search method will handle subfolders
'can use a recursive call here also to get subfolders though
    x.Add objFolder.Name
Next

Set objNS = Nothing
Set myFolder = Nothing
Set myOlApp = Nothing
End Sub