Vba Как искать в общем почтовом ящике на основе значений ячеек Excel - PullRequest
Новая
       13

Vba Как искать в общем почтовом ящике на основе значений ячеек Excel

0 голосов
/ 22 мая 2019

Я ищу макрос, который выполняет поиск в общих почтовых ящиках outlook на основе значения ячейки в диапазоне A: A, а затем пишет «Y» или «N» в B: B в зависимости от того, найдет ли он что-то или нет. Я хотел бы искать в теле и предмете, а также.

Например: в ячейке A1 есть номер 1111123, это номер, который я хочу найти в общих почтовых ящиках. Если макрос нашел совпадение, напишите «Y» в ячейку B1, если нет, напишите «N» Затем перейдите к ячейке A2 A3 A4 и т. Д. До последней ячейки в диапазоне A: A и запишите результаты в B2 B3 B4 и т. Д.

Вот моя лучшая попытка. Этот код ищет значение в активной ячейке внешнего вида и записывает «Y» или «N» в диапазон B1. Итак, у меня есть две проблемы. Я хочу, чтобы макрос не только находил значение активной ячейки, но и значение всего столбца 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

1 Ответ

1 голос
/ 23 мая 2019

Никогда не просматривайте все элементы в папке, всегда используйте Items.Find/FindNext или Items.Restrict. В вашем случае запрос будет 

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

Приведенное выше имя DASL соответствует свойству PR_BODY_W MAPI (нельзя использовать Body имя OOM в запросе).

Если вам нужны совпадения для нескольких значений, вам нужно создать соответствующий запрос, используя операторы «ИЛИ» и / или «И».

...