Как программно узнать закончил ли ZIP свою работу?

Public Function UnZipFile(ByVal DestPath$, ParamArray Files())
    '
    'Извлечение из архива
    'Аргументы:
    'DestPath - полный путь к папке для распаковки архива
    'Files - Без параметра все файлы, либо по индексу либо имени в архиве
    'Примечание: Имена файлов в архиве, должны быть полными !
    '
    Dim DestDir As Object, s$, f&, j$(), v As Variant
 
    If Not FolderExists(DestPath) Then 'Проверяем есть ли папка
        MkDir (DestPath) 'Создаём папку для перемещаемых туда объектов
    End If
    Set DestDir = Shell.NameSpace((DestPath))
 
    If IsMissing(Files) Then
        DestDir.CopyHere mArchive.Items 'Перемещаем все ...
        '
        '
        '===== Здесь нужен правильный код окончания операции ! ! !
        '
        '
    Else
 
        For Each v In Files 'Подготавливаем список для перемещения
 
            If IsNumeric(v) Then
                s = s & " " & mArchive.Items().Item((v)).Name
            Else
 
                For f = 0 To mArchive.Items.Count - 1
                    If v = mArchive.Items().Item((f)).Name Then s = s & " " & f
                Next
            End If
        Next
        j = Split(Mid$(s, 2)) 'Cписок для перемещения
 
        For f = 0 To mArchive.Items.Count - 1
            s = mArchive.Items().Item(CLng(j(f))).Name
            s = DestPath & "\" & s
            DestDir.CopyHere mArchive.Items.Item(CLng(j(f))) 'Перемещаем указнные инексы
 
            Do 'Ждём пока в папке назначения не появится файл
                Sleep 100 '1/10 доля секунды
            Loop While Len(Dir(s)) = 0
        Next
    End If
End Function

Public Function UnZipFile(ByVal DestPath$, ParamArray Files())
    '
    'Извлечение из архива
    'Аргументы:
    'DestPath - полный путь к папке для распаковки архива
    'Files - Без параметра все файлы, либо по индексу либо имени в архиве
    'Примечание: Имена файлов в архиве, должны быть полными !
    '
    Dim DestDir As Object, f&, v As Variant, ind&
    If (mArchive Is Nothing) Then Exit Function   'Проверяем указан ли архив ?
    ReDim Obj(mArchive.Items.Count - 1) As Object
    If Not FolderExists(DestPath) Then 'Проверяем есть ли папка
        MkDir (DestPath) 'Создаём папку для перемещаемых туда объектов
    End If
    Set DestDir = Shell.NameSpace((DestPath))
 
    If IsMissing(Files) Then
        DestDir.CopyHere mArchive.Items 'Перемещаем все ...
        '
        '
        '===== Здесь нужен правильный код окончания операции ! ! !
        '
        '
    Else
 
        For Each v In Files 'Подготавливаем список для перемещения
 
            If IsNumeric(v) Then
                'Если это индексы
                Set Obj(ind) = mArchive.Items().Item(CLng(v))
                If Not (Obj(ind) Is Nothing) Then ind = ind + 1
            Else
                'Если это имена
                Set Obj(ind) = mArchive.ParseName(CStr(v))
                If Not (Obj(ind) Is Nothing) Then ind = ind + 1
            End If
        Next
        
        For f = 0 To ind - 1 'Перемещаем выбранные объекты
            DestDir.CopyHere Obj(f)
            '
            '
            '===== Здесь нужен правильный код окончания операции ! ! !
            '
            '
        Next
    End If
End Function

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetActiveWindow Lib "user32" () As Long
 
Private Function CopyHere(Parent As Object, vItem, Optional vOptions) As Boolean
    '
    'Функция копирования
    'Аргументы: Папка (Zip-папка) // Копируемый объект
    '
    'Флаги опций
    '4 - Не показывать окно с прогресс-баром.
    '8 - Дать копируемому файлу новое имя, если файл с таким именем уже существует.
    '16 - Отвечать автоматически "Yes to All" в любом отображаемом диалоге.
    '256 - Отображать окно с прогресс-баром, но не показывать имена файлов.
    '4096 - Производить операции только в локальной папке. Не производить операции рекурсивно в подпапках.
    '9182 - Не копировать связанные файлы (например, html-файлы с их папками) как группу. Копировать только указанные файлы.
    '
    Dim oPr As Object, Name$, ModifyDate As Date
    Dim OldDate As Date, n&, h&
 
    OldDate = Shell.NameSpace(Parent.Self.Path).Self.ModifyDate
    Parent.CopyHere (vItem), vOptions
    On Error Resume Next
    If vItem.Count > 0 Then If Err.Number = 0 Then GoTo 1
    Do
        h = GetActiveWindow
        DoEvents
        Sleep 100
        n = n + Abs(h <> GetActiveWindow)
        ModifyDate = Shell.NameSpace(Parent.Self.Path).Self.ModifyDate
        Debug.Print ModifyDate, n
        If OldDate <> ModifyDate Or n > 1 Then Exit Do
    Loop
1
    CopyHere = True
End Function