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

Question

我想根据范围 A:A 中的单元格值搜索 Outlook 共享邮箱，然后根据是否找到某些内容将“Y”或“N”写入 B:B。
我也想搜索正文和主题。

例如：在单元格 A1 中有一个数字 1111123 可以在共享邮箱中搜索。
如果找到匹配项，则在单元格 B1 中写入“Y”，如果没有，则写入“N”。
然后转到单元格 A2、A3、A4 等，直到 A:A 区域中的最后一个单元格并将结果写入 B2、B3、B4 等。

此代码在 Outlook 中搜索活动单元格中的值，并将“Y”或“N”写入范围 B1。

1. 我希望宏不仅可以找到活动单元格的值，还可以逐个单元格地查找整个列 A 的值。
2. 这很慢。 大约需要 3-5 分钟才能找到单元格值。

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

Answer 1

永远不要遍历文件夹中的所有项目，始终使用Items.Find/FindNext或Items.Restrict 。 在您的情况下，查询将是

@SQL="http://schemas.microsoft.com/mapi/proptag/0x1000001F" LIKE '%Some value%' 

上面的 DASL 名称对应于PR_BODY_W MAPI 属性（您不能在查询中使用Body OOM 名称）。

如果您想匹配多个值，您需要使用“OR”和/或“AND”运算符创建适当的查询。