Найти электронную почту по телу и отправителю - PullRequest
Новая
       14

Найти электронную почту по телу и отправителю

0 голосов
/ 11 июня 2019

Я пытаюсь найти электронную почту, которая соответствует основному тексту и отправителю.

Каждый день я проверяю, отправлено ли уже 300/400 электронных писем.

Мне нужно перебрать более 4500электронные письма. 

Sub Check()
    Application.Calculation = xlManual
    Dim OutApp As Object
    Dim OutNameSpace As Object
    Dim OutFolder As Object
    Dim OutItms As Object
    Dim OutMail As Object

    Dim Last As Long
    Last = ThisWorkbook.Worksheets(2).Cells(Rows.Count, 2).End(xlUp).Row

    Set OutApp = CreateObject("Outlook.Application")
    Set OutNameSpace = OutApp.GetNamespace("MAPI")
    Set OutFolder = OutNameSpace.GetDefaultFolder(6).Folders("Inne")
    Set OutItms = OutFolder.Items

    Set numbers = ThisWorkbook().Sheets(2).Range(Cells(2, 2), Cells(Last, 2))
    Dim numer As Range
    For Each number In numbers
        Z = 1
        If numer = "" Then GoTo nastepny
        For Each OutMail In OutFolder.Items
            If InStr(1, OutMail.Body, number, vbTextCompare) <> 0 Then
                If InStr(1, OutMail.Sender, "Sender Name", vbTextCompare) <> 0 Then
                    number.Offset(0, 7) = "Yes"
                    GoTo nastepny
                End If
            Else
                number.Offset(0, 7) = "No"
            End If
nastepny:
    Next OutMail, number

    Application.Calculation = xlAutomatic

End Sub

Этот код перебирает все электронные письма и проверяет, есть ли электронное письмо с правильным номером в теле и правильным отправителем.Для более чем 4500 электронных писем требуется много времени, чтобы сделать это один за другим.

...