Как бы сделать??

[Dark]

Добрый день форумчане!
[INDENT]просьба помочь с решением небольшой задачки! Есть макрос который выполняет следующие действия:[/INDENT]
1. выводит диалоговое окно выбора папки для архивирования
2. после выбора папки, запускается архиватор и начинает забрасывать файлы из данной папки в архив имеющий определенное максимальное значение архива.
3. Запускается Lotus Notes (либо другой почтовый менеджер, у меня просто на работе он) и начинает создавать письма.
Задача: Реализовать возможность подсчета файлов в папке на момент ее выбора и после создания архивов (после чего посчитать разницу или посчитать конкретно кол-во ахивов в этой папке). Создать письма в Lotus'e по количеству сформированных архивных файлов.
Попробовал реализовать это так (заранее извиняюсь, т.к. макросы пишу совершенно не профессионально, поэтому многие спецы могут ужаснуться):
'-------ВЫБОР ПАПКИ--------
Set q = ThisWorkbook.Sheets("Лист2").Columns("A").Find(what:=Форма2.ФИО.Value)
Dim PS As String: PS = Application.PathSeparator
With Application.FileDialog(msoFileDialogFolderPicker)
If Not Right$(InitialPath, 1) = PS Then InitialPath = InitialPath & PS
.ButtonName = "Выбрать": .Title = Title: .InitialFileName = ThisWorkbook.Sheets("Лист2").Cells(q.Row, 2).Value & PS
If .Show <> -1 Then Exit Sub
GetFolderPath = .SelectedItems(1)
End With

'-------ПОДСЧЕТ ФАЙЛОВ ДО СОЗДАНИЯ АРХИВА-------
Set FSO = CreateObject("Scripting.FileSystemObject")
КоличествоФайловВПапкеДоАрхива = FSO.GetFolder(GetFolderPath).Files.Count


'---------ЗАПУСК АРХИВАТОРА----------
Dim ПутькАрхиву, ПутьКФайлу
If WinRar.Value = True Then
ПутькАрхиву = Путь_Архиватор + " a -r -ep1 -v6700"

ПутьКФайлу = GetFolderPath & PS


Shell ПутькАрхиву & " """ & ПутьКФайлу & Форма2.ФИО.Value & """ """ & ПутьКФайлу, vbHide


'----------ПОДСЧЕТ ФАЙЛОВ ПОСЛЕ СОЗДАНИЯ АРХИВА И РАСЧЕТ РАЗНИЦЫ-------
Set FSO = CreateObject("Scripting.FileSystemObject")
КоличествоФайловВПапкеПослеАрхива = FSO.GetFolder(GetFolderPath).Files.Count
d = КоличествоФайловВПапкеПослеАрхива - КоличествоФайловВПапкеДоАрхива

Else
MsgBox "Проверьте выбор Архиватора в настройках Админа"
Exit Sub

End If




'--------Создание писем по кол-ву созданных файлов архива-------
For X = 1 To d
Call ShellExecute(0&, "Open", "mailto:" & "--------" & "?Subject=" & Форма2.ФИО.Text & " " & X, "", "", 1)
Next X

End Sub

Проблема заключается в том что на стадии передачи задачи архиватору (например при архивировании "тяжелых" файлов макрос выполняет дальше свою задачу и например архиватор создал 4 файла, а так как макрос не ждет окончание действий архиватора, он показывает что создан 1 файл и соответственно формируется одно письмо. Думаю, что нужно применить действие DoEvents (или как-то стопорнуть программу до окончания архивирования), или другую какую-то команду, но не знаю как, т.к. не занимаюсь этим профессионально. Просьба помочь кто может. На всякий случай выкладываю исходник.

[pashulka]

Можно воспользоваться данным советом и замутить что-то вроде :

Код: Выделить всё

ПутькАрхиву = Путь_Архиватор & " a -ibck -r -ep1 -v6700"
ПутьКФайлу = GetFolderPath & PS
КомСтрока = ПутькАрхиву & " """ & ПутьКФайлу & Форма2.ФИО.Value & """ """ & ПутьКФайлу

Dim iWshShell As Object, iWshExec As Object
Set iWshShell = CreateObject("WScript.Shell")
Set iWshExec = iWshShell.Exec(КомСтрока)
    
Do
     'iWshExec.Terminate
     'Если понадобится завершить работу с запущенным приложением
Loop While iWshExec.Status = 0
'MsgBox "Вы закончили работу с архиватором", , ""

[Dark]

pashulka МЕГА РЕСПЕКТ!!
Все заработало, как надо!!
Закрываем тему!