Оптимизация кода – прокрутка / поиск электронной почты из Excel

У меня есть макрос, который перебирает элементы в папке «Входящие» и возвращает их отправкой ReportProvider (сохраняет данные в таблице 1). На данный момент макрос работает хорошо, но, на мой взгляд, он медленный – требуется около 2 минут, чтобы пройти через 6000 писем.

Есть ли способ сделать это быстрее?

Вот мой код:

Option Explicit Sub getOutlookData() Dim oApp As Outlook.Application Dim oMail As Object Dim oFolder, oSubFolder As Outlook.Folder Dim oSubject, oSender, oTime, oSubFolderID As String Dim oAttachment As Outlook.Attachment Dim i, j, k, counter As Integer Set oApp = New Outlook.Application Application.ScreenUpdating = False Range("Table1").AutoFilter If Range("Table1").Rows.Count > 1 Then Range("Table1").Rows.Delete ' clear the table i = 1 '========================= Get Number of Emails ========================= counter = 0 For Each oFolder In Outlook.Session.Folders If oFolder.Name = "[email protected]" Then For Each oSubFolder In oFolder.Folders If oSubFolder.Name = "Inbox" Then oSubFolderID = oSubFolder.EntryID counter = counter + oSubFolder.Items.Count End If Next oSubFolder End If Next oFolder '========================= /Get Number of Emails ========================= '========================= Get Emails sent by provider ========================= Set oSubFolder = Outlook.Session.GetFolderFromID(oSubFolderID) For Each oMail In oSubFolder.Items statusView.Show ' show status dialog Call Status(oMail.Parent.Parent.Name & "/" & oMail.Parent.Name, oMail.Subject, "Checked " & k & "/" & counter) 'update status dialog k = k + 1 If oMail.Class = 43 Then If oMail.SenderName = "ReportRrovider" Then With Range("Table1") statusView.Label4 = "Found " & j ' update status dialog .Cells(i, 1).Value = oMail.Parent.Parent.Name & "/" & oMail.Parent.Name .Cells(i, 2).Value = oMail.SenderName .Cells(i, 3).Value = oMail.Subject .Cells(i, 4).Value = CDate(oMail.SentOn) If oMail.attachments.Count > 0 Then .Cells(i, 5).Value = oMail.attachments.Item(1).Size If oMail.attachments.Count > 0 Then .Cells(i, 6).Value = oMail.attachments(1).DisplayName .Cells(i, 7).Value = oMail.EntryID .Cells(i, 8).Value = oSubFolder.EntryID .Cells(i, 9).Value = CDate(oMail.ReceivedTime) .Cells(i, 10).Formula = "=VLOOKUP([@Attachment],MappingTable[#All],2,0)" .Cells(i, 10).Copy .Cells(i, 10).PasteSpecial xlValues i = i + 1 j = j + 1 End With End If End If Next oMail Unload statusView ' hide status dialog Application.ScreenUpdating = True 'Call downloadAttachments End Sub Sub status(Optional ByVal caption1 As String, Optional ByVal caption2 As String, Optional ByVal caption3 As String, Optional ByVal caption4 As String) If caption1 <> "" Then statusView.label1.Caption = caption1 If caption2 <> "" Then statusView.label2.Caption = caption2 If caption3 <> "" Then statusView.label3.Caption = caption3 If caption4 <> "" Then statusView.Label4.Caption = caption4 End Sub 

Я буду признателен, если вы сможете опубликовать метод / трюк с объяснением того, как он работает, или почему это лучшее решение, а не только код-ответ. Мне важно узнать эти вещи 🙂

С наилучшими пожеланиями

Wujaszkun

Никогда, никогда не перебирайте все элементы в папке. Используйте Items.Find/FindNext или Items.Restrict . Запрос, который вы хотите, это "[SenderName] = 'ReportRrovider'" .

Кроме того, нет абсолютно никаких оснований для вычисления oMail.Parent.Parent.Name & "/" & oMail.Parent.Name на каждом шаге цикла: значение будет одинаковым для всех элементов в данной папке. вычислить его перед входом в цикл

Давайте начнем с идей обновления:

 Dim oSubject as string, oSender as string , oTime as string, oSubFolderID As String Dim oAttachment As Outlook.Attachment Dim i as long, j as long, k as long, counter As long 

Таким образом вы объявляете их явно указанному типу, иначе они являются вариантами, и это дорого. Кроме того, не используйте Integer в VBA, он меньше и медленнее, чем длинный.

  • Установить публичную переменную по умолчанию в первый раз и увеличить ее в следующий раз?
  • Вставить содержимое ячеек в Outlook, поддерживая форматирование
  • Подпись vba outlook с именем отправителя
  • Вставить Word.Document в тело электронной почты?
  • получить определенную текстовую строку из Outlook
  • Подстрочный код за пределами диапазона при попытке получить количество записей в столбце
  • PrimeFaces Data Exporter экспортирует лист в dataTable filtering
  • Почему окно редактора Visual Basic открывается, когда я подключаюсь к своему компьютеру, если он был ранее открыт, но был закрыт?
  • Почему копирование строки из Outlook в Excel открывает новый экземпляр Excel для каждого электронного письма?
  • Папка Excel VBA в виде изображения в Outlook без записи содержимого тела в сообщении
  • Проблема с удалением встреч из общего календаря Outlook
  • Interesting Posts

    VBA – макрос запуска при выборе переключателя

    Хранение массивов в массивах

    Считать, если элемент рядом с полем содержит определенный текст

    Использование INSERT INTO для записи данных в базу данных доступа

    открыть xml для запроса выделенных ячеек

    Excel – Сравнение четырех столбцов

    Excel VBA – выбор, получение и установка данных в таблице

    Нужно указать номер последней строки, содержащий комментарий

    Как задержать формулу, которая будет отображаться в течение определенного количества часов?

    Проверка строки заголовка в загруженном файле Excel Классический ASP

    Excel. Вычислить дату, ближайшую к системной дате.

    Как я могу удалить элемент из массива?

    В Excel, как заполнять ячейку на основе соответствия между строкой в ​​одном листе и столбцом на другом листе

    Использование вложенных, если дать конкретный ответ в excel

    Ошибка ввода команды: «Ошибка времени выполнения '91': переменная объекта или с переменной блока не установлена"

    Давайте будем гением компьютера.