VBA Распаковщик архивов

[Ethex]

Доброго времени суток
Есть процедура, извлекающая файлы из архивов в подкаталогах

Public Sub UnRAR()
Dim winRarApp As String, archName As String
Dim fso, fold, subfold, file
Dim RetVal
    If Me.Поле0 <> 0 Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fold = fso.GetFolder(Me.Поле0)
        For Each subfold In fold.Subfolders
            For Each file In subfold.Files
                If file.Name Like "*rar" Or file.Name Like "*zip" Or file.Name Like "*7z" Then
                winRarApp = sWinRarAppPath & " E -o+"
                archName = subfold.Path & "\" & file.Name
                RetVal = Shell(winRarApp & " """ & archName & """ """ & subfold.Path & """ ", vbHide)
                End If
            Next
        Next
    Set fso = Nothing
    Else
    MsgBox "Каталог не выбран"
    End If
End Sub

Как я понял, строка

RetVal = Shell(winRarApp & " """ & archName & """ """ & subfold.Path & """ ", vbHide)

запускает процесс извлечения, после чего цикл идёт дальше, не дожидаясь пока файлы не будут извлечены. Когда я тестировал на каталоге, где было около 30 папок, вышло так, что процедура завершилась, оставив меня наблюдать порядка тридцати процессов извлечения файлов

А существует ли возможность как-нибудь приостановить выполнение цикла на время, нужное для извлечения файла(ов) и затем запустить его заново?

[p51x]

http://www.cpearson.com/excel/ShellAndWait.aspx

[Ethex]

Сообщение от p51x

http://www.cpearson.com/excel/ShellAndWait.aspx

Скопировал функцию. При компиляции выдаёт Method or data member not found в строке

SaveCancelKey = Application.EnableCancelKey

[p51x]

Ну напишите свою простую обертку. Там всего лишь не забыть сохранить пид и подождать в WaitForSingleObject

[Ethex]

Сообщение от p51x

Ну напишите свою простую обертку

Public Function wait(winRarApp As String, archName As String, subfoldPath As String)
Dim pID As Long, pHandle As Long, WaitProcess As Long
pID = Shell(winRarApp & " """ & archName & """ """ & subfoldPath & """ ", vbHide)
pHandle = OpenProcess(&H100000, True, pID)
WaitProcess = WaitForSingleObject(pHandle, INFINITE)
End Function

Собственно, копировать всю функцию пытался оттого что увидел много незнакомых слов и кода. Пришлось покумекать. Не буду врать что удалось полностью разобраться - это ещё предстоит. Но получилось то что выше. И оно работает. Спасибо за подробную наводку

[p51x]

Только не забывает закрывать хендл с помощью CloseHandle.

[Ethex]

Сообщение от p51x

Только не забывает закрывать хендл с помощью CloseHandle.

Агась, учтено