Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
VBA Excel выявление последнего письма в папке Outlook
 
#1
28.01.2021 14:30:11
Всем добрый день.
Подскажите пожалуйста, есть ли способы макросом выявить последнее (по времени) поступившее письмо в конкретную папку Outlook?

Глобально, мне необходимо, чтобы макрос проверял, что в указанной ему папке как минимум за последний час присутствовали письма (туда автоматизированно поступают отчеты о работе другого макроса)

Я реализовал это перебором всех писем в папке и если письмо прислано за последний час, то +1 к объявленной константе, собственно, если константа по выходу из цикла равна 0, то писем за последний час не было и макрос об этом оповещает.

Но данный способ не очень оптимален, если в папке будет 5000 писем, мне по факту то нужно последнее по времени пришедшее.

Возможно есть какой то способ определять макросом самое верхнее письмо, но тогда как поведет себя макрос, если у него в Outlook будет стоять сортировка не по дате, или можно перед началом перебора цикла существует какая то функция, которая правит сортировку папку, т.е. ставить макросом сортировку по дате, загонять цикл перебора не всех писем, а с первого по 5, например

Буду благодарен за любую помощь и совет
Свой код не прикладываю, потому что очень сложно вычленить именно ту часть, о которой идет речь из структуры большого макроса
Изменено: Дмитрий Попов - 28.01.2021 14:34:26
 
 
 
#2
28.01.2021 14:36:39
Вот здесь показывал как можно отбирать по условию без перебора всех писем: Как можно ускорить обработку писем из почты?
Главное, правильно составить строку отбора. Какие-то примеры есть и в интернете. Вам, скорее всего, нужен такой запрос:
Код
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:datereceived" & Chr(34) & " <= '" & Format(Now, "dd/MM/yyyy hh:mm:ss AM/PM") & "' AND " & _
                          Chr(34) & "urn:schemas:httpmail:datereceived" & Chr(34) & " >= '" & Format(Now - TimeSerial(1, 0, 0), "dd/MM/yyyy hh:mm:ss AM/PM") & "'"
Изменено: Дмитрий(The_Prist) Щербаков - 28.01.2021 14:37:09
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#3
28.01.2021 14:44:30
Цитата
Дмитрий(The_Prist) Щербаков написал:
Главное, правильно составить строку отбора. Какие-то примеры есть и в интернете. Вам, скорее всего, нужен такой запрос:
Добрый день, спасибо за быстрый ответ.
Т.е. я сначала ограничиваю массив данных с помощью поиска по дате, а уже внутри этого массива осуществляю перебор писем. В моем случае вообще не так важно осуществлять перебор писем в этом массиве, главное, чтобы Count по ним был больше 0, если я задам условия поиска за последний час от текущего времени.
Спасибо огромное, буду пробовать, такие примеры видел, не пришло сразу в голову
 
 
 
#4
29.01.2021 10:02:38
Добрый день. Ещё раз благодарю за помощь) Получилось всё настроить гораздо проще чем было до этого
Итоговый код получился следующий (попробовал вытащить именно часть, о которой писал в своем запросе):

Код без циклов проверяет наличие за последний час поступивших сообщений в определенную папку в почте, ранее я это делал циклом For, который чекал каждое письмо, вытаскивал из него дату и время поступления и если дата и время соответствовали периоду 1 час, то прибавлял для обнуленной константы +1 и соответственно по выходу из цикла проводилась проверка константы, если она не равна 0, то письма были, всё ок. Такой способ не оптимален, ввиду того, что фактически меня интересует последнее направленное письмо по дате и всё, если в папке 1000 или 100000 писем, то код будет исполняться зря)
Код
Sub CheckReport 
    Dim olApp As Outlook.Application, objnamespace As Namespace
    Dim mail_name As String
    Set olApp = New Outlook.Application
    Set objnamespace = olApp.GetNamespace("MAPI")
    mail_name = ThisWorkbook.Worksheets("Список").Cells(2,2) 'название ящика считывается из ячейки в файле Excel
    Set items_post_tf = objnamespace.Folders(mail_name).Folders("Отчеты") 'наименование папки в ящике, в которой будем смотреть письма
    Set items_mail_tf = item_post_tf.Items
    
    CheckTime = Format(DateAdd("n", -60, Now()), "dddd hh:mm") 'Считаем минус 1 час от текущего времени, для установки фильтра
    strfilter = "[ReceivedTime]>'" & CheckTime & "'" 'параметры фильтра, который будет применяться к папке значение времени поступления письма больше CheckTime
    Set filtered_items = items_mail_tf.Restrict(strfilter) 'применение фильтра по параметрам выше
    CounterTF = filtered_items.Count 'подсчет количества писем удовлетворяющих условию
    If CounterTF = 0 MsgBox "Новые отчеты в течение часа не поступали"
End Sub
Изменено: Дмитрий Попов - 29.01.2021 10:06:18
 
 
 
Страницы: 1
Наверх