Как программно узнать закончил ли 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

Option Explicit
Private Declare Function SHParseDisplayName Lib "shell32" (ByVal pszName As Long, ByVal IBindCtx As Long, ByRef ppidl As Long, sfgaoIn As Long, sfgaoOut As Long) As Long
Private Declare Function ILFree Lib "shell32" (ByVal pidlFree As Long) As Long
Private Declare Function lstrcpyn Lib "kernel32" Alias "lstrcpynW" (ByVal lpString1 As Long, ByVal lpString2 As Long, ByVal iMaxLength As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
 
Private Const ZipFldrCLSID = "{E88DCCE0-B7B3-11d1-A9F0-00AA0060FA31}"
Private Const IID_IShellExtInit = "{000214E8-0000-0000-C000-000000000046}"
 
Private Sub IStorageRead(IStorageInZIP As IStorage, Optional PathFolder As String)
    Dim enm As IEnumSTATSTG
    Dim itm As STATSTG
    Dim nam As String
    Dim cb As Long
    
    Set enm = IStorageInZIP.EnumElements
    
    enm.Reset
    Do While enm.Next(1, itm) = S_OK
        cb = lstrlen(itm.pwcsName)
        nam = Space(cb)
        lstrcpyn StrPtr(nam), itm.pwcsName, cb + 1
        CoTaskMemFree itm.pwcsName
        
        If itm.Type <> STGTY_STORAGE Then
            If Len(PathFolder) > 0 Then
                List1.AddItem PathFolder & "\" & nam
            Else
                List1.AddItem nam
            End If
        Else
            IStorageRead IStorageInZIP.OpenStorage(nam, 0, STGM_READ, 0, 0), IIf(PathFolder <> "", PathFolder & "\" & nam, nam)
        End If
    Loop
End Sub
 
Private Sub ReadingStructureZIP(ByVal FileName As String)
    Dim clsid   As UUID
    Dim iidSh   As UUID
    Dim shExt   As IShellExtInit
    Dim pf      As IPersistFolder2
    Dim pidl    As Long
    
    CLSIDFromString ZipFldrCLSID, clsid
    CLSIDFromString IID_IShellExtInit, iidSh
    
    If CoCreateInstance(clsid, Nothing, CLSCTX_INPROC_SERVER, iidSh, shExt) <> S_OK Then Exit Sub
    Set pf = shExt
    SHParseDisplayName StrPtr(FileName), 0, pidl, 0, 0
    pf.Initialize pidl
    ILFree pidl
    
    IStorageRead pf
End Sub
 
Private Sub Form_Load()
    Text1.Text = App.Path & "\test.zip"
    ReadingStructureZIP Text1.Text
    If List1.ListCount > 0 Then List1.Selected(0) = True
End Sub

Option Explicit
Private Declare Function SHParseDisplayName Lib "shell32" (ByVal pszName As Long, ByVal IBindCtx As Long, ByRef ppidl As Long, sfgaoIn As Long, sfgaoOut As Long) As Long
Private Declare Function ILFree Lib "shell32" (ByVal pidlFree As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Private Const ZipFldrCLSID = "{E88DCCE0-B7B3-11d1-A9F0-00AA0060FA31}"
Private Const IID_IShellExtInit = "{000214E8-0000-0000-C000-000000000046}"
 
Private Sub ReadingStructureZIP(ByVal FileName As String)
    Dim clsid   As UUID
    Dim iidSh   As UUID
    Dim shExt   As IShellExtInit
    Dim pf      As IPersistFolder2
    Dim pidl    As Long
    
    CLSIDFromString ZipFldrCLSID, clsid
    CLSIDFromString IID_IShellExtInit, iidSh
    
    If CoCreateInstance(clsid, Nothing, CLSCTX_INPROC_SERVER, iidSh, shExt) <> S_OK Then Exit Sub
    Set pf = shExt
    SHParseDisplayName StrPtr(FileName), 0, pidl, 0, 0
    pf.Initialize pidl
    ILFree pidl
    
    IStorageRead pf
End Sub
 
Private Sub IStorageRead(IStorageInZIP As IStorage, Optional PathFolder As String)
    Dim enm As IEnumSTATSTG
    Dim itm As STATSTG
    Dim nam As String
    Dim cb As Long
    
    Set enm = IStorageInZIP.EnumElements
    
    enm.Reset
    Do While enm.Next(1, itm) = S_OK
        nam = SysAllocString(itm.pwcsName)
        CoTaskMemFree itm.pwcsName
        
        If itm.Type = STGTY_STREAM Then
            List1.AddItem IIf(PathFolder <> "", PathFolder & "\" & nam, nam)
        ElseIf itm.Type = STGTY_STORAGE Then
            IStorageRead IStorageInZIP.OpenStorage(nam, 0, STGM_READ, 0, 0), IIf(PathFolder <> "", PathFolder & "\" & nam, nam)
        End If
    Loop
End Sub
 
Private Sub LoadFileFromZIP(ByVal FileName As String, ByVal FileNameInZIP As String)
    Dim clsid   As UUID
    Dim iidSh   As UUID
    Dim shExt   As IShellExtInit
    Dim pf      As IPersistFolder2
    Dim pidl    As Long
    
    CLSIDFromString ZipFldrCLSID, clsid
    CLSIDFromString IID_IShellExtInit, iidSh
    
    If CoCreateInstance(clsid, Nothing, CLSCTX_INPROC_SERVER, iidSh, shExt) <> S_OK Then Exit Sub
    Set pf = shExt
    SHParseDisplayName StrPtr(FileName), 0, pidl, 0, 0
    pf.Initialize pidl
    ILFree pidl
    
    UnpackFileFromZIP pf, FileNameInZIP
End Sub
 
Private Sub UnpackFileFromZIP(IStorageInZIP As IStorage, ByVal FileNameInZIP As String, Optional PathFolder As String)
    Dim enm As IEnumSTATSTG
    Dim itm As STATSTG
    Dim nam As String
    Dim cb As Long
    Dim FileName As String
    Dim stm As IStream
    Dim bArray() As Byte
    Dim my_size As Long
    
    Set enm = IStorageInZIP.EnumElements
    
    enm.Reset
    Do While enm.Next(1, itm) = S_OK
        nam = SysAllocString(itm.pwcsName)
        CoTaskMemFree itm.pwcsName
        FileName = IIf(PathFolder <> "", PathFolder & "\" & nam, nam)
        
        If itm.Type = STGTY_STREAM Then
            If FileName = FileNameInZIP Then
                Set stm = IStorageInZIP.OpenStream(nam, 0, STGM_READ, 0)
                
                my_size = itm.cbSize * 10000@
                ReDim bArray(my_size - 1)
                
                stm.Read bArray(0), my_size
                Picture1.Picture = SimpleLoadPicture(bArray)
            End If
        ElseIf itm.Type = STGTY_STORAGE Then
            UnpackFileFromZIP IStorageInZIP.OpenStorage(nam, 0, STGM_READ, 0, 0), FileNameInZIP, FileName
        End If
    Loop
End Sub
 
Private Function SimpleLoadPicture(bPic() As Byte) As StdPicture
    On Error Resume Next
    
    With CreateObject("WIA.Vector")
        .BinaryData = bPic
        Set SimpleLoadPicture = .Picture
    End With
End Function
 
Private Sub Form_Load()
    Text1.Text = App.Path & "\test.docx"
    ReadingStructureZIP Text1.Text
    
    If List1.ListCount > 0 Then
        List1.Selected(0) = True
        Label1.Caption = "Count files: " & List1.ListCount
    End If
End Sub
 
Private Sub List1_Click()
    Dim tick As Long
    
    tick = GetTickCount
    LoadFileFromZIP Text1.Text, List1.Text
    Label2.Caption = "ms: " & (GetTickCount - tick)
End Sub
 
Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        KeyAscii = 0
        
        List1.Clear
        ReadingStructureZIP Text1.Text
        
        If List1.ListCount > 0 Then
            List1.Selected(0) = True
            Label1.Caption = "Count files: " & List1.ListCount
            List1.SetFocus
        End If
    End If
End Sub

                If my_size > 0 Then
                    ReDim bArray(my_size - 1)
                    
                    stm.Read bArray(0), my_size
                    Picture1.Picture = SimpleLoadPicture(bArray)
                End If

Private Sub UnpackFileFromZIP(IStorageInZIP As IStorage, ByVal FileNameInZIP As String, Optional PathFolder As String)
    Dim enm As IEnumSTATSTG
    Dim itm As STATSTG
    Dim nam As String
    Dim cb As Long
    Dim FileName As String
    Dim stm As IStream
    Dim bArray() As Byte
    Dim my_size As Long
    
    Set enm = IStorageInZIP.EnumElements
    
    enm.Reset
    Do While enm.Next(1, itm) = S_OK
        nam = SysAllocString(itm.pwcsName)
        CoTaskMemFree itm.pwcsName
        FileName = IIf(PathFolder <> "", PathFolder & "\" & nam, nam)
        
        If itm.Type = STGTY_STREAM Then
            If FileName = FileNameInZIP Then
                Set stm = IStorageInZIP.OpenStream(nam, 0, STGM_READ, 0)
                my_size = itm.cbSize * 10000@
                
                If my_size > 0 Then
                    ReDim bArray(my_size - 1)
                    
                    stm.Read bArray(0), my_size
                    Picture1.Picture = SimpleLoadPicture(bArray)
                End If
                
                Set stm = Nothing
            End If
        ElseIf itm.Type = STGTY_STORAGE Then
            UnpackFileFromZIP IStorageInZIP.OpenStorage(nam, 0, STGM_READ, 0, 0), FileNameInZIP, FileName
        End If
    Loop
End Sub

Option Explicit
Private Declare Function SHParseDisplayName Lib "shell32" (ByVal pszName As Long, ByVal IBindCtx As Long, ByRef ppidl As Long, sfgaoIn As Long, sfgaoOut As Long) As Long
Private Declare Function ILFree Lib "shell32" (ByVal pidlFree As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Private Const ZipFldrCLSID = "{E88DCCE0-B7B3-11d1-A9F0-00AA0060FA31}"
Private Const IID_IShellExtInit = "{000214E8-0000-0000-C000-000000000046}"
 
Private Sub ReadingStructureZIP(ByVal FileName As String)
    Dim clsid   As UUID
    Dim iidSh   As UUID
    Dim shExt   As IShellExtInit
    Dim pf      As IPersistFolder2
    Dim pidl    As Long
    
    CLSIDFromString ZipFldrCLSID, clsid
    CLSIDFromString IID_IShellExtInit, iidSh
    
    If CoCreateInstance(clsid, Nothing, CLSCTX_INPROC_SERVER, iidSh, shExt) <> S_OK Then Exit Sub
    Set pf = shExt
    SHParseDisplayName StrPtr(FileName), 0, pidl, 0, 0
    pf.Initialize pidl
    ILFree pidl
    
    IStorageRead pf
End Sub
 
Private Sub IStorageRead(IStorageInZIP As IStorage, Optional PathFolder As String)
    Dim enm As IEnumSTATSTG
    Dim itm As STATSTG
    Dim nam As String
    Dim cb As Long
    
    Set enm = IStorageInZIP.EnumElements
    
    enm.Reset
    Do While enm.Next(1, itm) = S_OK
        nam = SysAllocString(itm.pwcsName)
        CoTaskMemFree itm.pwcsName
        
        If itm.Type = STGTY_STREAM Then
            List1.AddItem IIf(PathFolder <> "", PathFolder & "\" & nam, nam) & IIf(itm.cbSize, "    " & itm.cbSize * 10000@ & " bytes", "")
        ElseIf itm.Type = STGTY_STORAGE Then
            IStorageRead IStorageInZIP.OpenStorage(nam, 0, STGM_READ, 0, 0), IIf(PathFolder <> "", PathFolder & "\" & nam, nam)
        End If
    Loop
End Sub
 
Private Sub LoadFileFromZIP(ByVal FileName As String, ByVal FileNameInZIP As String)
    Dim clsid   As UUID
    Dim iidSh   As UUID
    Dim shExt   As IShellExtInit
    Dim pf      As IPersistFolder2
    Dim pidl    As Long
    
    CLSIDFromString ZipFldrCLSID, clsid
    CLSIDFromString IID_IShellExtInit, iidSh
    
    If CoCreateInstance(clsid, Nothing, CLSCTX_INPROC_SERVER, iidSh, shExt) <> S_OK Then Exit Sub
    Set pf = shExt
    SHParseDisplayName StrPtr(FileName), 0, pidl, 0, 0
    pf.Initialize pidl
    ILFree pidl
    
    LoadPictureFileFromZIP pf, FileNameInZIP
End Sub
 
Private Sub LoadPictureFileFromZIP(IStorageInZIP As IStorage, ByVal FileNameInZIP As String, Optional PathFolder As String)
    Dim enm As IEnumSTATSTG
    Dim itm As STATSTG
    Dim nam As String
    Dim cb As Long
    Dim FileName As String
    Dim stm As IStream
    
    Set enm = IStorageInZIP.EnumElements
    
    enm.Reset
    Do While enm.Next(1, itm) = S_OK
        nam = SysAllocString(itm.pwcsName)
        CoTaskMemFree itm.pwcsName
        FileName = IIf(PathFolder <> "", PathFolder & "\" & nam, nam)
        
        If itm.Type = STGTY_STREAM Then
            If FileName = FileNameInZIP Then
                Set stm = IStorageInZIP.OpenStream(nam, 0, STGM_READ, 0)
                If itm.cbSize Then Picture1.Picture = LoadPictureFromStream(stm)
                Set stm = Nothing
            End If
        ElseIf itm.Type = STGTY_STORAGE Then
            LoadPictureFileFromZIP IStorageInZIP.OpenStorage(nam, 0, STGM_READ, 0, 0), FileNameInZIP, FileName
        End If
    Loop
End Sub
 
Private Sub Form_Load()
    Text1.Text = App.Path & "\test.docx"
    ReadingStructureZIP Text1.Text
    
    If List1.ListCount > 0 Then
        List1.Selected(0) = True
        Label1.Caption = "Count files: " & List1.ListCount
    End If
End Sub
 
Private Sub List1_Click()
    Dim tick As Long
    
    tick = GetTickCount
    LoadFileFromZIP Text1.Text, Mid$(List1.Text, 1, InStr(1, List1.Text, "    ") - 1)
    Label2.Caption = "ms: " & (GetTickCount - tick)
End Sub
 
Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        KeyAscii = 0
        
        List1.Clear
        ReadingStructureZIP Text1.Text
        
        If List1.ListCount > 0 Then
            List1.Selected(0) = True
            Label1.Caption = "Count files: " & List1.ListCount
            List1.SetFocus
        End If
    End If
End Sub

If SHParseDisplayName(StrPtr(FileName), 0, pidl, 0, 0) <> S_OK Then Exit Sub