Zipping files is slow

[Abraxus]

I'm currently using this code to zip files, but it's pretty slow.

Code: Select all

Sub CreateZipFile(folderToZipPath As Variant, zippedFileFullName As Variant)
    Dim ShellApp As Object
    'Create an empty zip file
    Open zippedFileFullName For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
   Close #1

    'Copy the files & folders into the zip file
    Set ShellApp = CreateObject("Shell.Application")
    ShellApp.Namespace(zippedFileFullName).CopyHere ShellApp.Namespace(folderToZipPath).items


    'Zipping the files may take a while, create loop to pause the macro until zipping has finished.
    On Error Resume Next
    Do Until ShellApp.Namespace(zippedFileFullName).items.Count = ShellApp.Namespace(folderToZipPath).items.Count
        Sleep 1000
    Loop
    On Error GoTo 0

End Sub

Anyone have anything faster?

[HansV]

Does it help if you replace

Sleep 1000

with

DoEvents

[snb]

Code: Select all

Sub M_snb()
'   zip all files and folders in G:\OF\ into G:\__ziptest.zip

   CreateObject("scripting.filesystemobject").CreateTextFile("G:\__ziptest.zip").write "PK" & Chr(5) & Chr(6) & String(18, 0)
   
   With CreateObject("Shell.Application")
     .Namespace("G:\__ziptest.zip").CopyHere .Namespace("G:\OF\").Items
   End With
End Sub

[robertocm]

Maybe using 7z

Just an idea for the command (but this is AutoIt)

Code: Select all

;use x command to keep the folder stucture, -aoa Overwrite All existing files without prompt, use -r to unzip the subfolders from the zip file
RunWait('"' & $Path7z & '\7z.exe" x -aoa -r -y "' & $sFolder & $aFileList[$i] & '" -o"' & $sTempDir & '"', $Path7z, @SW_HIDE)

Just some code for getting the output in VBA

Code: Select all

Dim objShell As Object, objCmdExec As Object, cmd As String, CommandOutput As String
cmd = "ipconfig /all"
Set objShell = CreateObject("WScript.Shell")
Set objCmdExec = objShell.exec(cmd)
CommandOutput = objCmdExec.StdOut.ReadAll

References:
7-zip.chm (see 7-Zip directory)
[VBA] Run Application - Capture Output
Execute a console program and capture its output
Execute AutoIt and wait for finish

[Abraxus]

Does it help if you replace

Sleep 1000

with

DoEvents

For the test I ran it was 8% faster. My way took 13 minutes, yours took 12. :-)

But for larger runs, 8% is a good amount of savings.

[Abraxus]

Code: Select all

Sub M_snb()
'   zip all files and folders in G:\OF\ into G:\__ziptest.zip

   CreateObject("scripting.filesystemobject").CreateTextFile("G:\__ziptest.zip").write "PK" & Chr(5) & Chr(6) & String(18, 0)
   
   With CreateObject("Shell.Application")
     .Namespace("G:\__ziptest.zip").CopyHere .Namespace("G:\OF\").Items
   End With
End Sub

Thanks for the suggestion. This one took the same amount of time as my code, though.

[snb]

In that case:

Code: Select all

Sub M_snb()
  createobject("scripting.filesystemobject").createtextfile("G:\OF\beispiel.txt").write createobject("wscript.shell").exec("cmd /c dir ""G:\OF\*.*"" /b/s").stdout.readall
End Sub

1. Mal : ziemlich 'langsam'
2. Mal: blitzschnell

Warum ZIP ?

[ChrisGreaves]

I'm currently using this code to zip files, but it's pretty slow.

"Slow" is a relative term, as is faster, and you don't give any figures for number of files to be zipped, size and type of file and so on.
From Word2003 VBA I call a DOS Batch file to drive a 1993 version of PKZIP.EXE. (42 KB)
If you have not already done so, you might want to compare times for your code and for a Command prompt run of PKZIP.EXE.

I'd suggest that you run each test after a reboot to flush out any cached buffers, memory etc. to provide a reasonably fair comparison.

Cheers, Chris

[SpeakEasy]

CopyHerehas a reputation for being slow in comparison to other Windows file copy methods particularly as the file count goes up, mainly because it is doing a LOT of heavy lifting in the background.

That being said, zipping itself is also time consuming. So, as Chris says above, number of files to be zipped, size and type of file will all have an impact (and maybe enough impact that the CopyHere overhead becomes irrelevant).

But try the following (somewhat obscure) code to see if it improves things at all (it is leveraging Powershell's ability to use .Net classes, in this instance the ZipFile class):

Code: Select all

Public Sub CreateZipFile(folderToZipPath As String, zippedFileFullName As String)
    If Dir(zippedFileFullName) <> "" Then Kill zippedFileFullName
    PS_Execute "Add-Type -Assembly 'System.IO.Compression.Filesystem';[System.IO.Compression.ZipFile]::CreateFromDirectory('" & folderToZipPath & "', '" & zippedFileFullName & "', 1, $false)"
End Sub

' Utility routine to run a Powershell command
Public Sub PS_Execute(ByVal sPSCmd As String)
    Dim result As Long
    sPSCmd = "powershell.exe -command " & sPSCmd
    Dim wshell As Object
    Set wshell = CreateObject("WScript.Shell")
    result = wshell.Run(sPSCmd, 0, True) ' synchronous version
End Sub

[SpeakEasy]

Should have said that the above is if you really insist on sticking with what Microsoft provide. If you are happy to switch to an alternative, then robertocm's suggestion of 7-zip - it's free, has a commandline component (and thus unhindered by maintaining a GUI), and is fast.