Dir()函数找不到刚刚解压缩的文件?

时间:2015-05-27 14:28:08

标签: excel-vba vba excel

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

到目前为止,我已多次成功使用它,但现在我正在尝试使用两次压缩的下载文件。我遇到的问题是下面代码的第二部分中的Dir()函数找不到一次解压缩的.zip文件,直到我以某种方式停止宏。

我尝试过的事情: 在第二次解压缩部分之前放置DoEvents并等待1秒钟

有效: 打开宏,将“Run to Cursor”执行到代码第二部分顶部的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。

1 个答案:

答案 0 :(得分:2)

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