In the ZipPackage procedure demonstrated here, you are creating an empty .zip file and then filling it with the contents of a source directory. Notice that you are using the Sleep API function here. This lets you pause Excel for a specified number of milliseconds. Pausing Excel allows each file to be completely compressed and saved before moving on the next file. In this procedure, you are making Excel sleep for 500 milliseconds each time you copy a file to the .zip container:
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim ZipFile, TargetFolder, NewFileName, ofile Dim o As Object
'Create Empty Zip Package
ZipFile = "C:\UpdatedFile.zip" Open ZipFile For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0) Close #1
'Indentify Folder with Source Files TargetFolder = "C:\MyUnzipped"
'Check for empty folder
If Len(Dir$(TargetFolder & "\*.*")) < 1 Then
MsgBox "There are no files in your target folder" Kill ZipFile Exit Sub End If
'Copy each file to the zip file On Error Resume Next
Set o = CreateObject("Shell.Application") For Each ofile In o.Namespace(TargetFolder).items o.Namespace(ZipFile).CopyHere (ofile) Sleep 500 Next ofile
'Rename the container to change the file extension to xlsx Name ZipFile As Replace$(ZipFile, ".zip", ".xlsx")
Kill ZipFile Set o = Nothing End Sub
Was this article helpful?