Outlook vba зацикливается на контактах очень медленно - PullRequest
Новая
       20

Outlook vba зацикливается на контактах очень медленно

0 голосов
/ 23 февраля 2020

Я связал свои контакты icloud с outlook и хотел отобразить все контакты, которые не были сгруппированы. Я написал этот саб для этого: 

Option Explicit

Sub Ungrouped()
    Dim NS As Outlook.NameSpace
    Dim c1 As Outlook.ContactItem, c2 As Outlook.ContactItem
    Dim iCloud As Outlook.MAPIFolder, Ungrouped As Outlook.MAPIFolder
    Dim fol As Outlook.MAPIFolder, tempfol As Outlook.MAPIFolder
    Dim i As Integer

    Set NS = Application.GetNamespace("MAPI")
    Set iCloud = NS.Folders("iCloud").Folders("Contacts")
    Set Ungrouped = iCloud.Folders("Ungrouped")
    Set tempfol = NS.GetDefaultFolder(olFolderContacts)

    Do Until i = iCloud.items.Count
        i = i + 1
        Set c1 = iCloud.items(i)

        If c1.FileAs <> c1.FullName Then
            c1.FileAs = c1.FullName
            c1.Save
        End If

        For Each fol In iCloud.Folders
            For Each c2 In fol.items
                If c1 = c2 Then GoTo found
            Next c2
        Next fol

        'if contact is not added to any folder, move to tempfol
        c1.Move tempfol
        i = i - 1
found:
    Loop

    'move all contacts from tempfol to ungrouped
    Do While tempfol.items.Count > 0
        tempfol.items(1).Move Ungrouped
    Loop
End Sub

Код работает точно так, как задумано. Мне пришлось сделать обход через tempfol, потому что переход непосредственно из «icloud contacts root» в «папку контактов icloud» не работал. Хотя это не очень элегантно, использование tempfol работает.

Самая большая проблема - это скорость. Каждый контакт в папке root проверяется на соответствие каждому контакту в подпапках. Для моих 125 контактов это занимает 75 секунд ...

Потеря скорости не в движении, потому что даже без каких-либо движущихся операций время так долго.

Кто-нибудь знает что-нибудь хороший способ ускорить это?

...