CODEWITHSUNDEEP
excelvba
user4691433
user4691433

Reputation:

Dir() function can't find freshly unzipped files?

I've been unzipping files using Example 1 of Ron de Bruin's oft-cited unzipping macro found here: http://www.rondebruin.nl/win/s7/win002.htm

I have used it successfully many times so far, but now I am trying to work with downloaded files that are twice-zipped. The problem that I am running into is that the Dir() function in the second portion of code below cannot find the once-unzipped .zip files until I stop the macro in some way.

What I've Tried: Putting DoEvents and a 1-second Wait before the second unzipping portion

What Works: Opening the macro, doing "Run to Cursor" to the Dir() line at the top of the second portion of code, and then hitting continue.

Desired behavior: That the macro is able to run through with a single command rather than having to have it stop via Run to Cursor.

Copying the relevant consecutive portions of code below, the first portion works and the following portion needs the extra push:

'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

This portion requires me the "Run to Cursor" or the Dir() function will not find the unzipped files and the second unzipping will be skipped. The once-unzipped files end with ".out.zip". Don't ask me, that's just how I receive them. I have tried putting DoEvents and a one-second wait right before the second line below:

    '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

Other Notes: I have DoEvents in one line of my code that occurs earlier than these two portions.

I use Excel 2010.

Upvotes: 1

Views: 182

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149277

1 Second wait time is way too less. You have two options.

A) Either increase the wait time. Paste this procedure

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

and just before the Dir command type Wait 15. This means your code will wait for 15 seconds before DIR executes again. You can change it to any appropriate number. 15 is just an example.

B) I would prefer the second way. Here you will loop till DIR finds something in that folder but at the same time I will merge the above code with this

Here is an example

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

You can add more functionality to the loop for example, number of attempts. See this

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

Upvotes: 1

Related Questions