Question

我正在寻找一个宏，该宏基于范围A：A中的单元格值在Outlook共享邮箱中进行搜索，然后根据是否找到内容，在B：B中写入“ Y”或“ N”。我也想搜索身体和主题。

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

这是我的最佳尝试。该代码在Outlook中的活动单元格中搜索值，并在范围B1中写入“ Y”或“ N”。所以我有两个问题。我希望宏不仅可以找到活动单元格的值，还可以逐个单元格地找到整个列A.的值。我的另一个问题是，这确实很慢。查找单元格值大约需要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

从不循环浏览文件夹中的所有项目，请始终使用PasswordInfo或Items.Find/FindNext。就您而言，查询将是

Items.Restrict

上面的DASL名称与@SQL="http://schemas.microsoft.com/mapi/proptag/0x1000001F" LIKE '%Some value%' MAPI属性相对应（您不能在查询中使用PR_BODY_W OOM名称）。

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

Vba如何根据Excel单元格值在共享邮箱Outlook中搜索

1 个答案: