Функция Dir() не может найти свежие распакованные файлы?

Question

Я распаковка файлов, используя пример 1 из часто цитируемой распаковки макрос Рона де Бруина нашли здесь: http://www.rondebruin.nl/win/s7/win002.htm

Я использовал его успешно много раз до сих пор, но сейчас я пытаюсь работать с загруженными файлами, которые дважды заархивированы. Проблема, с которой я сталкиваюсь, заключается в том, что функция Dir() во второй части нижеприведенного кода не может найти однократно распакованные файлы .zip, пока я не остановлю макрос каким-либо образом.

Что я пробовал: DoEvents и реализация концепции с 1-секундной паузой перед второй частью

распаковки

Что Работы: Открытие макроса, делая «Бегите Cursor» на Dir () в верхней части второй части кода, а затем нажмите продолжить.

Желаемая поведение: Это макрос может пробежать с помощью одной команды вместо того, чтобы его остановить с помощью Run для курсора.

Копирование соответствующих последовательных участков кода ниже, первая часть работы и следующая часть нуждается дополнительный толчок:

'835 Unzipping and Copying Only 
If String8 = "835" Then 
    'Rename as (Directory) (Date) (File Type) (Business Line) (file extension) 
    Name String1 As String3 & String9 & " " & String8 & "s " & String11 & ".zip" 
    'Save the complete path as one string 
    String5 = String3 & String9 & " " & String8 & "s " & String11 & ".zip" 
    'String6 is the 835s Archive 
    String6 = (full file path, obscured for privacy, can insert generic path if needed) 
    'Database Folder 
    String7 = (full file path, obscured for privacy, can insert generic path if needed) 
    'Copy from the download folder to the archive folder and the database folder 
    FileCopy String5, String6 
    FileCopy String5, String7 
    Kill String5 
    'Unzip selected archive 
    Set Object1 = CreateObject("Shell.Application") 
    String12 = (directory only path with trailing backslash) 
    Variant1 = String12 
    Variant2 = String7 
    Object1.Namespace(Variant1).CopyHere Object1.Namespace(Variant2).items 
    On Error Resume Next 
    Set Object2 = CreateObject("scripting.filesystemobject") 
    Object2.deletefolder Environ("Temp") & "\Temporary Directory*", True 
    On Error GoTo 0 
    Kill String7 

Эта часть требует мне «Бегите Курсор» или функция Dir() будет не находите распакованные файлы, а второй разгрузочный файл будет пропущен. Однократно распакованные файлы заканчиваются на «.out.zip». Не спрашивайте меня, вот как я их получаю. Я попытался положить DoEvents и один-второй ждать прямо перед второй строкой ниже:

'Further unzipping 
    String4 = Dir(String12 & "*.out.zip") 
    Do While String4 <> "" 
     'Save the complete path of the file found 
     String5 = String12 & String4 
     'Unzip selected archive 
     Variant1 = String12 
     Variant2 = String5 
     Object1.Namespace(Variant1).CopyHere Object1.Namespace(Variant2).items 
     On Error Resume Next 
     Object2.deletefolder Environ("Temp") & "\Temporary Directory*", True 
     On Error GoTo 0 
     Kill String5 
     String4 = Dir(String12 & "*.out.zip") 
    Loop 
    GoTo AllDone 
End If 

Другие Примечания: Я имею DoEvents в одной строке моего кода, который происходит раньше, чем эти две части.

Я использую Excel 2010.

Answer 1

1 Второе время ожидания слишком мало. У вас есть два варианта.

A) Увеличьте время ожидания. Вставить эту процедуру

Private Sub Wait(ByVal nSec As Long) 
    nSec = nSec + Timer 
    While nSec > Timer 
     DoEvents 
    Wend 
End Sub 

и перед типом Dir команды Wait 15. Это означает, что ваш код будет ждать 15 секунд до повторного выполнения DIR. Вы можете изменить его на любой подходящий номер. 15 - всего лишь пример.

B) Я бы предпочел второй способ. Здесь будет цикл до DIR находит что-то в этой папке, но в то же время я солью выше код с помощью этого

Вот пример

Do While Dir(String12 & "*.out.zip") = "" 
    Wait 2 
Loop 

Private Sub Wait(ByVal nSec As Long) 
    nSec = nSec + Timer 
    While nSec > Timer 
     DoEvents 
    Wend 
End Sub 

Вы можете добавить больше функциональные возможности к петле, например, количество попыток. См. Это

Dim numberOfAttmpts As Long 

Do While Dir(String12 & "*.out.zip") = "" 
    Wait 2 

    numberOfAttmpts = numberOfAttmpts + 1 

    If numberOfAttmpts > 5 Then 
     MsgBox "5 attempts also failed. Exiting" 
     Exit Sub 
    End If 
Loop 

Private Sub Wait(ByVal nSec As Long) 
    nSec = nSec + Timer 
    While nSec > Timer 
     DoEvents 
    Wend 
End Sub