Programmatically Zipping an Excel Container

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)

Sub ZipPackage()

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")

'Clean up

Kill ZipFile Set o = Nothing End Sub

0 0

Post a comment