Макрос подсчета сообщений Outlook работает медленно

Question

С помощью нескольких постов здесь о переполнении стека я написал этот макрос для Outlook, который будет подсчитывать количество сообщений, поступивших на этой неделе в определенную папку, с разбивкой непрочитанных сообщений по сравнению с общим количеством сообщений за неделю.

Проблема в том, что он работает очень медленно, и в настоящее время в папке меньше 100 сообщений. Действительно медленно = outlook приостанавливается на несколько секунд, прежде чем всплывет окно с результатами.

Я предполагаю, что есть гораздо более эффективный способ сделать это. Можете ли вы указать мне правильное направление?

Мой текущий код:

Dim Vfolder As Outlook.Folder
Set Vfolder = Application.Session.Folders("abc").Folders("123")

Dim x As Long   ' Unread messages in folder from this week
Dim y As Long   ' Total messages in folder from this week
Dim i As Long   ' loop

Dim objMail As Outlook.MailItem
Dim DateReceived As Date
Dim FullDateReceived As Date
Dim DateTest As Date
DateTest = Date - Weekday(Date, vbMonday) + 1

For i = 1 To Vfolder.Items.Count

If Vfolder.Items.Item(i).Class = olMail Then
    Set objMail = Vfolder.Items.Item(i)
    FullDateReceived = objMail.ReceivedTime
    DateReceived = Year(FullDateReceived) & "-" & Month(FullDateReceived) & "-" & Day(FullDateReceived)
    If DateReceived >= DateTest Then
        If objMail.UnRead Then
            x = x + 1
            y = y + 1
        Else
            y = y + 1
        End If
    End If
End If


Next

Answer 1

Как правило, никогда не пропускайте от oop до всех элементов в папке - в конце концов, вы бы никогда не запустили запрос SQL без предложения WHERE, не так ли?

Хуже того, вы используете многоточечную нотацию (Vfolder.Items.Item(i)), которая заставляет OOM возвращать новый объект Items на каждой итерации l oop.

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

dt = Now-7
strDate =  FormatDateTime(dt, 2) 
set vfolder = Application.ActiveExplorer.CurrentFolder
y = Vfolder.Items.Restrict("[ReceivedTime] > '" & strDate & "'").Count
x = Vfolder.Items.Restrict("([Unread] = true) and ([ReceivedTime] > '" & strDate & "')").Count