Dir() 函数找不到新解压缩的文件？答案

【问题标题】：Dir() function can't find freshly unzipped files?Dir() 函数找不到新解压缩的文件？
【发布时间】：2015-05-27 23:03:27
【问题描述】：

我一直在使用 Ron de Bruin 经常被引用的解压缩宏示例 1 解压缩文件：http://www.rondebruin.nl/win/s7/win002.htm

到目前为止，我已经成功使用过很多次，但现在我正在尝试处理已下载的两次压缩文件。我遇到的问题是，在我以某种方式停止宏之前，下面代码第二部分中的 Dir() 函数无法找到曾经解压缩的 .zip 文件。

我的尝试： 在第二个解压缩部分之前放置 DoEvents 和 1 秒等待

有效的方法： 打开宏，对代码第二部分顶部的 Dir() 行执行“运行到光标”，然后点击继续。

期望的行为： 宏能够通过单个命令运行，而不必通过 Run to Cursor 让它停止。

复制下面相关的连续代码部分，第一部分有效，以下部分需要额外推送：

'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。

【问题讨论】：

++ 我喜欢人们能很好地解释他们的问题：) 节省大量时间！绝对值得一票！
非常感谢！我认为尽可能清楚地解释所有内容是 SO 出色的发布指南的自然延伸，并使该网站易于使用。其他人的帖子，包括您自己的答案，通过这样做为我节省了大量阅读和理解的时间，并成为了很好的榜样。
太棒了 :) 好的，你能帮我检查一下吗？在 DIR 之前放置一个断点并手动检查文件夹并查看文件是否已被提取。如果您没有看到它们，请按F5 帮助吗？
让我们continue this discussion in chat.

标签： excel vba

【解决方案1】：

1 秒的等待时间太短了。你有两个选择。

A) 要么增加等待时间。粘贴此过程

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

就在Dir 命令类型Wait 15 之前。这意味着您的代码将在 DIR 再次执行之前等待 15 秒。您可以将其更改为任何适当的数字。 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

【讨论】：