Excel的VBA：通过Outlook电子邮件所有子文件夹循环，从而找到电子邮件与特定主题

Question

我已经写在Excel VBA下面的代码与打开电子邮件给定的主题，如果设在Outlook中的默认收件箱文件夹。

不过，我想搜索该邮件在收件箱中的所有子文件夹。

由于代码将被多个用户使用，我不知道的数量和他们的Outlook收件箱中的子文件夹的名称。关于如何在所有子文件夹中搜索此电子邮件的任何想法？

Sub GetEmail() 

    Dim OutApp as Object 
    Dim Namespace as Object 
    Dim Folder as Object 
    Dim myMail as Object 

    Set OutApp = CreateObject("Outlook.Application") 
    Set Namespace = OutApp.GetNamespace ("MAPI") 
    Set Folder = Namespace.GetDefaultFolder(6) 

    Set myMail = Folder.Items.Find ("[Subject] = ""Test""") 

    myMail.Display 


End Sub 

Answer 1

下面的代码循环浏览Outlook中的所有文件夹，到收件箱下面的级别。您只需指定要查看的初始文件夹即可查看收件箱。因此，您可以在循环时搜索文件夹。你可以通过循环更深，或者说folders.count> X.

我一直觉得展望从Excel令人沮丧所以取得了这个早期势必使编码更容易添加更多的子文件夹。这意味着您需要转到工具/参考并添加Microsoft Outlook 16（x）.0对象库

编码后您可以将其更改回迟到界限，因为早期绑定会为您提供智能感知并使生活成为很容易。

Sub GetEmail() 

Dim OutApp As Outlook.Application 
Dim Namespace As Outlook.Namespace 
Dim Mfolder As Outlook.MAPIFolder 
Dim myMail As Outlook.Items 

Dim Folder As Outlook.MAPIFolder 
Dim SubFolder As Outlook.MAPIFolder 
Dim UserFolder As Outlook.MAPIFolder 

Set OutApp = New Outlook.Application 
Set Namespace = OutApp.GetNamespace("MAPI") 

On Error Resume Next 
For Each Folder In Namespace.Folders 
    For Each SubFolder In Folder.Folders 
     For Each UserFolder In SubFolder.Folders 
      Debug.Print Folder.Name, "|", SubFolder.Name, "|", UserFolder.Name 
     Next UserFolder 
    Next SubFolder 
Next Folder 
On Error GoTo 0 

End Sub 

错误是跳过任何问题与Outlook映射存档pst文件。