J'ai une macro qui parcourt les éléments de ma boîte de réception et les renvoie par ReportProvider (enregistre les détails dans Table1). À ce stade, la macro fonctionne bien mais à mon avis, elle est lente - il faut environ 2 minutes pour parcourir 6000 e-mails.

Y a-t-il un moyen de le faire plus rapidement?

Voici mon code:

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

J'apprécierai si vous pouviez publier une méthode / astuce avec des explications sur son fonctionnement ou pourquoi est-ce une meilleure solution plutôt que simplement une réponse par code. C'est important pour moi d'apprendre ces choses :)

Meilleures salutations

Wujaszkun

1
Wujaszkun 17 janv. 2017 à 13:41

2 réponses

Meilleure réponse

Jamais, jamais parcourir tous les éléments d'un dossier. Utilisez Items.Find/FindNext ou Items.Restrict. La requête souhaitée est "[SenderName] = 'ReportRrovider'".

De plus, il n'y a absolument aucune raison de calculer oMail.Parent.Parent.Name & "/" & oMail.Parent.Name à chaque étape de la boucle: la valeur sera la même pour tous les éléments d'un dossier donné. le calculer avant d'entrer dans la boucle

1
Dmitry Streblechenko 17 janv. 2017 à 22:07

Commençons par les idées de mise à jour:

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

De cette façon, vous les déclarez explicitement au type donné, sinon ils sont des variantes, et cela coûte cher. De plus, n'utilisez pas Integer dans VBA, il est plus petit et plus lent que long.

2
Vityata 17 janv. 2017 à 10:52