Retrieve List of Files Inside ZIP File

Question

I am sending MS Access files to a zip file to back them up every night by means of an MS Access file. Some are large files, upwards of 2GB, which take 5 to 10 minutes to zip on our slow shared drive network. I want my ACCDB file to pause until the file has been completely copied into the zip file before moving on to the next file. It currently just goes on to the next file almost immediately and things get messed up pretty quickly, especially since I am killing the MS Access file after it gets copied into the zip.

Try to find the file in the zip, and then I will eventually build a loop with a timer that goes until the Dir exists.

'copy files to zip
Dim shl As New Shell32.Shell
shl.NameSpace(strZipFilePath).CopyHere (strZip)

Set sh = CreateObject("Shell.Application")
x = GetFiles(strPath, "*.zip", True)
'This crashes Access
For Each i In x
    Set n = sh.NameSpace(i)
    Debug.Print n
    Next i
End

Pause for 600 seconds... sometimes this works, other times it doesn't, just depends on network traffic.

Do While Dir(strZip) <> 0
        sngStart = ""
        sngStart = Timer
        Do While Timer < sngStart + 600 '10 minutes=600 seconds
            DoEvents
        Loop
Loop

Maybe just use a slow loop and check the last modified on the zip, until it hasn't changed for x minutes. — Tim Williams, Nov 01 '19 at 17:46
Potential second option. Depending on how you're zipping the files you could have VBA call a batch file or other command line code using the WScript shell and wait for output indicating success or failure. https://stackoverflow.com/questions/15951837/wait-for-shell-command-to-complete — Mike, Nov 01 '19 at 18:17

Gustav · Answer 1 · 2019-11-02T08:37:21.043

You may use a method similar to what I do when zipping files and folders using an API call to sleep:

        With ShellApplication
            Debug.Print Timer, "Zipping started . ";
            .Namespace(CVar(ZipTemp)).CopyHere CVar(Path)
            ' Ignore error while looking up the zipped file before is has been added.
            On Error Resume Next
            ' Wait for the file to created.
            Do Until .Namespace(CVar(ZipTemp)).Items.Count = 1
                ' Wait a little ...
                Sleep 50
                Debug.Print ".";
            Loop
            Debug.Print
            ' Resume normal error handling.
            On Error GoTo 0
            Debug.Print Timer, "Zipping finished."
        End With

It is taken from my article:

Zip and unzip files and folders with VBA the Windows Explorer way

(If you don't have an account, browse for the link: Read the full article.)

Full code is also on GitHub: VBA.Compress

where also the Sleep function is found in the module FileCompress.bas

' Suspends the execution of the current thread until the time-out interval elapses.
'
#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" ( _
        ByVal dwMilliseconds As Long)
#Else
    Private Declare Sub Sleep Lib "kernel32" ( _
        ByVal dwMilliseconds As Long)
#End If

Ran the code behind a command button in an access form and it all worked just fine. Need to copy all of the files to a temp folder first, then run the remaining code. Thank you for providing this. I actually used something similar to this approach. But this code is much more thorough, si just replaced the Sleep (which only works in Excel) with Timer and it works great. — JustAnotherFaceInTheCode, Nov 01 '19 at 21:05
`Sleep` is an API function: https://stackoverflow.com/questions/22325958/declaring-calling-the-sleep-api @JustAnotherFaceInTheCode — Andre, Nov 01 '19 at 22:57
_it works great_ - thanks, then please mark as answered. However, you should use the true `Sleep` function which now is included. Thanks @Andre. — Gustav, Nov 02 '19 at 08:39

Retrieve List of Files Inside ZIP File

1 Answers1