VBA - Zipping Files Using Word (Simple Tutorial)

You might have come across this tutorial: http://www.rondebruin.nl/windowsxpzip.htm about zipping files in VBA with the default Windows zipper program. This is a really good example of how to do it within Excel, but you might hit some problems when you start to copy it in Word.

I'll cover a really simple example of how to do it in Word.

Firstly, declare the library that allows us to tell the application to wait or "sleep". This will become important when we are waiting on files to be added to our zip file.

Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

Next declare the following variables:

Dim ShellApplication As Object 'Shell Application that we will use to copy files to the zip folder

Dim ZipFilePath As Array 'A string variable for the file path the zip should be written to

Dim FileNamesArray 'A variant to act as an array to store the file names

We'll poach the NewZip method from the original Excel tutorial, which will create an empty zip file at the location specified by the sPath parameter.

Sub NewZip(sPath)

If Len(Dir(sPath)) > 0 Then Kill sPath

Open sPath For Output As #1

Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)

Close #1

End Sub

Great, we're ready to get started with the zipping. Declare a Sub of your choice for the code and lets pretend we have 2 input files for simplicity. This could be passed to the method as a parameter or a dialogue box could be used for selecting them but we will keep it simple for now.

Dim FileNameString As String

FileNameString = "C:\Desktop\InputFile1 , C:\Desktop\InputFile2"

FileNamesArray = Split(FileNames, ",")

So we have split the input string of files names on commas and put each item into the array. Not that FileNamesArray is not actually typed as an Array - it's actually a Variant so we will have to be careful later on when retrieving items from it.

Next we'll define the output destination for the zip file.

FileNameZip = "C:\Desktop\MyZipFile.zip"

Now we are ready to call the NewZip method on the location we just specified.

NewZip (ZipFilePath)

This should create an empty zip file where we told it to. Now we are ready to copy the files to the zip folder.

Remember the Shell Application we defined at the start? We need to initialise it.

Set ShellApplication = CreateObject("Shell.Application")

Now we need to loop over all the items in the FileNamesArray and copy them to the zip folder. We need to declare a counter for selecting items in the array as well as a checker to see that the current item has been copied to the zip file before adding another.

Dim Counter, ItemChecker As Integer

Counter = 0 'array index of the item being copied

ItemChecker = 0 'will be used to check if the current file has been copied

This just leaves looping over the array and copying the files.

For Counter = 0 to UBound(FileNamesArray) 'gets the size of the array

ItemChecker = ItemChecker + 1 'increment the item count

ShellApplication.Namespace(ZipFilePath).CopyHere CStr(FNames(Counter)) 'copy the files to the zip folder

Notice the CStr method call - this parses a Variant to a String. This is very important because the copy will fail otherwise - we didn't specifically define a String Array at the start remember.

Finally, we need to tell the application to wait until the the current file has been copied before moving on to the next one. We can do this by using the Items.Count value which tells use how many items are in the location we pass to it - in this case the ZipFilePath.

Do Until ShellApplication.Namespace(ZipFilePath).Items.Count = ItemChecker

Sleep 500 'go to sleep for a tiny moment

Loop

Next Counter

And hurray! We're done :)