让VBA遍历Outlook中的所有收件箱，包括共享收件箱

Sub TraverseInboxes()
    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.Namespace
    Dim objFolder As Outlook.Folder
    
    ' 创建Outlook应用程序对象
    Set objOutlook = New Outlook.Application
    ' 获取Outlook命名空间
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    
    ' 遍历所有收件箱
    For Each objFolder In objNamespace.Folders
        TraverseFolder objFolder
    Next objFolder
    
    ' 释放对象
    Set objFolder = Nothing
    Set objNamespace = Nothing
    Set objOutlook = Nothing
End Sub

Sub TraverseFolder(ByVal objFolder As Outlook.Folder)
    Dim objSubfolder As Outlook.Folder
    Dim objMailItem As Outlook.MailItem
    
    ' 遍历当前文件夹中的邮件
    For Each objMailItem In objFolder.Items
        ' 在这里可以对每封邮件进行处理，例如打印邮件主题
        Debug.Print objMailItem.Subject
    Next objMailItem
    
    ' 遍历当前文件夹中的子文件夹
    If objFolder.Folders.Count > 0 Then
        For Each objSubfolder In objFolder.Folders
            TraverseFolder objSubfolder
        Next objSubfolder
    End If
    
    ' 释放对象
    Set objSubfolder = Nothing
    Set objMailItem = Nothing
End Sub