问如何根据Excel单元格值搜索共享邮箱？

EN

Option Explicit
    
Public Sub Search_Outlook_Emails()
    
    Dim outApp As Outlook.Application
    Dim outNs As Outlook.Namespace
    Dim outStartFolder As Outlook.MAPIFolder
    Dim foundEmail As Outlook.MailItem
        
    Set outApp = New Outlook.Application
    Set outNs = outApp.GetNamespace("MAPI")     
    
    Set outStartFolder = outNs.GetDefaultFolder(Outlook.olFolderInbox).Parent    
      
    'Set outStartFolder = outNs.PickFolder
    
    If Not outStartFolder Is Nothing Then
            
        Set foundEmail = Find_Email_In_Folder(outStartFolder, ActiveCell.Value)
            
        If Not foundEmail Is Nothing Then
            Range("B1").Select
            ActiveCell.FormulaR1C1 = "Y"    
        End If
                
    Else
            
        Range("B1").Select
        ActiveCell.FormulaR1C1 = "N"
                
    End If
    
End Sub
    
    
Private Function Find_Email_In_Folder(outFolder As Outlook.MAPIFolder, findText As String) As Outlook.MailItem
        
    Dim outItem As Object
    Dim outMail As Outlook.MailItem
    Dim outSubFolder As Outlook.MAPIFolder
    Dim i As Long
        
    Debug.Print outFolder.FolderPath
        
    Set Find_Email_In_Folder = Nothing
        
    'Search emails in this folder
        
    i = 1
    While i <= outFolder.Items.Count And Find_Email_In_Folder Is Nothing
        
        Set outItem = outFolder.Items(i)
                    
        If outItem.Class = Outlook.OlObjectClass.olMail Then
                
            'Does the findText occur in this email's body text?
                           
            Set outMail = outItem
            If InStr(1, outMail.Body, findText, vbTextCompare) > 0 Then Set Find_Email_In_Folder = outMail
                
        End If
            
        i = i + 1
            
    Wend
        
    DoEvents
        
    'If not found, search emails in subfolders
        
    i = 1
    While i <= outFolder.Folders.Count And Find_Email_In_Folder Is Nothing
        
        Set outSubFolder = outFolder.Folders(i)
            
        'Only check mail item folders
            
        If outSubFolder.DefaultItemType = Outlook.olMailItem Then Set Find_Email_In_Folder = Find_Email_In_Folder(outSubFolder, findText)
        
        i = i + 1
            
    Wend
        
End Function