VBA Прослушка окончания работы Object("WScript.Shell").Exec

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

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

03.07.2025 15:45:18

Понадобилось получать данные о банках по БИК. Честно думал, уже есть что-то готовое, но гугл не помог.

Проблема возникает при распаковке архива от Банка России.
Как костыль поставил просто задержку, но хотелось бы, чтобы код останавливался, а потом понимал, что распаковка завершена и возобновлялся.

Приложил пример, xml не прикрепляется, так что в архиве, если с Банка России качать, то там ок 700 кБ

Код

Sub DownloadBikFile(myPath As String, fileName As String)
    Dim HttpObj As Object, StreamObj As Object, FileObj As Object
    Set HttpObj = CreateObject("Microsoft.XMLHTTP")
    HttpObj.Open "GET", "http://cbr.ru/s/newbik", False
    HttpObj.send
    If HttpObj.Status = 200 Then
        Set StreamObj = CreateObject("ADODB.Stream")
        StreamObj.Open
        StreamObj.Type = 1
        StreamObj.Write HttpObj.responseBody
        StreamObj.SaveToFile myPath & "\temp.zip", 2
        StreamObj.Close
        CreateObject("WScript.Shell").Exec ("powershell -command Expand-Archive -LiteralPath '" & myPath & "\temp.zip" & "' -DestinationPath '" & myPath & "'")
'===================================================
        
        
        Application.Wait Now + #12:00:05 AM#
        
        
'===================================================
        Set FileObj = CreateObject("Scripting.FileSystemObject")
        FileObj.getfile(myPath & "\temp.zip").Delete
        FileObj.getfile(myPath & "\" & fileName).Delete
        For Each i In FileObj.getfolder(myPath).Files
            If Right(i.Name, 3) = "xml" Then
                i.Name = fileName
                Exit For
            End If
        Next
    End If
End Sub

Прикрепленные файлы

test.xlsm (26.33 КБ)
Справочник_БИК.rar (2.01 КБ)

Изменено: Nartiny - 03.07.2025 15:53:16

Msi2102 Пользователь Сообщений: 4149 Регистрация: 31.03.2014	#2 03.07.2025 15:59:41 Тут подобная тема была

Nartiny

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

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

03.07.2025 17:07:23

Цитата
Msi2102 написал: Тут подобная тема была

Спасибо, всё работает

Финальный код:

Код

Sub DownloadBikFile(myPath As String, fileName As String)
    Dim HttpObj As Object, StreamObj As Object, FileObj As Object, deCompObj As Object
    Set HttpObj = CreateObject("Microsoft.XMLHTTP")
    HttpObj.Open "GET", "http://cbr.ru/s/newbik", False
    HttpObj.send
    If HttpObj.Status = 200 Then
        Set StreamObj = CreateObject("ADODB.Stream")
        StreamObj.Open
        StreamObj.Type = 1
        StreamObj.Write HttpObj.responseBody
        StreamObj.SaveToFile myPath & "\temp.zip", 2
        StreamObj.Close
        Set deCompObj = CreateObject("WScript.Shell").Exec("powershell -command Expand-Archive -LiteralPath '" & myPath & "\temp.zip" & "' -DestinationPath '" & myPath & "'")
        Do While deCompObj.Status = 0
        Loop
        Set FileObj = CreateObject("Scripting.FileSystemObject")
        FileObj.getfile(myPath & "\temp.zip").Delete
        If FileObj.FileExists(myPath & "\" & fileName) Then FileObj.getfile((myPath & "\" & fileName)).Delete
        For Each i In FileObj.getfolder(myPath).Files
            If Right(i.Name, 3) = "xml" Then
                i.Name = fileName
                Exit For
            End If
        Next
    End If
End Sub

Читают тему