Question

我有一个循环浏览收件箱中项目的宏，并通过ReportProvider返回这些发送（保存表1中的详细信息）。在这一点上，宏运行良好，但在我看来它很慢 - 循环6000电子邮件需要大约2分钟。

有没有办法更快地完成？

这是我的代码：

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 = "wujaszkun@company-where-i-work.com" 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

Answer 1

让我们从更新的想法开始：

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

通过这种方式，您可以明确地将它们声明为给定类型，否则它们是变体，这很昂贵。此外，不要在VBA中使用Integer，它比较长且慢。

Answer 2

永远不要遍历文件夹中的所有项目。使用Items.Find/FindNext或Items.Restrict。您想要的查询是"[SenderName] = 'ReportRrovider'"。

此外，绝对没有理由在循环的每一步计算oMail.Parent.Parent.Name & "/" & oMail.Parent.Name：对于给定文件夹中的所有项，该值都是相同的。在进入循环之前计算它

代码优化 - 循环/搜索来自Excel的电子邮件

2 个答案: