Как определить момент окончания архивации WinRAR в VBA?

Пользователь

Сообщений: 122 Регистрация: 01.01.1970

10.09.2015 23:17:03

Уважаемые форумчане подскажите пожалуйста, а возможно ли определить момент окончания архивации файла перед выполнением очередного действия с данным RAR архивом?
Есть некий код:

Код

Public Function FileToRAR()
    FilePath = Application.GetOpenFilename("Files,*.xl*;*.doc*", 0, "Выберите файлы для обработки", "Выбрать", True)
    WinRarAppPath = "C:\Program Files\WinRAR\WinRAR.exe"   'указываем папку с Winrar
    WinRarApp = WinRarAppPath & " A -ep"
    ArhiveName = "D:\Test.rar"а

'Действие 1. Архивация
    FileToRAR = Shell(WinRarApp & " """ & ArhiveName & """ """ & FilePath & """ ", vbNormalFocus)  'Архивируем все файлы списка

'Действие 2. что то делаем с ArhiveName

End Function

В настоящий момент при архивации большого файла при Действие 2 возникает ошибка.
Для ее исключения пользуюсь функцией Application.Wait, где "Выдержка" зависит от размера архивируемого файла (определял опытным путем)

Код
Application.Wait Time:=Now + Выдержка

может есть иной способ определения окончания работы WinRAR, т.е. избежать лишних действий и формул?

Изменено: Aleksey - 10.09.2015 23:25:38

Казанский Пользователь Сообщений: 8839 Регистрация: 11.01.2013	#2 10.09.2015 23:42:39 Aleksey, используйте WScript.Shell Run с последним параметром True: http://www.script-coding.com/WSH/WshShell.html#3.4. PS последняя точка должна входить в ссылку, движок форума не позволяет это сделать Изменено: Казанский - 10.09.2015 23:45:50

Игорь

Пользователь

Сообщений: 3695 Регистрация: 23.12.2012

10.09.2015 23:44:19

в цикле проверяйте наличие архива ArhiveName
чтобы цикл повторялся, пока файл не появится (но не более заданного времени, например, 10 секунд, - чтобы не зависло)

можно проверять также размер файла ArhiveName
если в течение секунды-другой он не изменился, - значит, архивация завершена

Надстройки для Excel Парсинг сайтов Мониторинг цен конкурентов

The_Prist

Пользователь

Сообщений: 15493 Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

10.09.2015 23:49:27

Можно через API попробовать:

Код

Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As LongPtr, ByVal dwMilliseconds As LongPtr) As LongPtr
Private Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwAccess As LongPtr, ByVal fInherit As Integer, ByVal hObject As LongPtr) As LongPtr
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As LongPtr

Public Sub WaitForProcessToEnd(toShellComand As String, WinStyle, Optional lWait = -1)
'lWait = -1 значит ожидать завершения процесса. Можно указать время ожидания в миллисекундах
  Dim retVal, hID, hHandle
  pID = Shell(toShellComand, WinStyle)
  pHandle = OpenProcess(&H100000, True, hID)
  retVal = WaitForSingleObject(pHandle, lWait)
  
  CloseHandle pHandle
End Sub

Public Function FileToRAR()
'    Dim sFilePath As String
    sFilePath = Application.GetOpenFilename("Files,*.xl*;*.*", 0, "Выберите файлы для обработки", "Выбрать", True)
    WinRarAppPath = "C:\Program Files (x86)\WinRAR\WinRAR.exe"   'указываем папку с Winrar
    WinRarApp = WinRarAppPath & " A -ep"
    ArhiveName = "C:\Test.rar"
'Действие 1. Архивация
    WaitForProcessToEnd WinRarApp & " """ & ArhiveName & """ """ & sFilePath(1) & """ ", vbHide   'Архивируем все файлы списка
'Действие 2. что то делаем с ArhiveName
    
End Function

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...

Читают тему