[AccessD] ZIpping Files

There has just been a discussion over on dba-Tech about the built in Zip capabilities in 
Windows (XP onwards?) where "Compressed (zipped) Folders" are just ordinary zip files.

This  got me thinking about how you could use the built in capabilities to manage zip files  
through VBA rather than needing a third party DLL, the Winzip CLI or whatever.

Turns out it is trivial to to create an empty ZIp file, it is just a string of 22 bytes as follows:

Function CreateNewZipFolder(Filename As String) As Long
Dim strEmptyZip As String
strEmptyZip = Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String$(18, Chr$(0))
Open Filename For Binary As #1
Put #1, , strEmptyZip
Close #1
End Function

You can now use a Shell.Application object to work with this file/folder.

Firstly set a reference to  Microsoft Shell Controls and Automation:  Shell32.dll

Then you just need a couple of simple functions:

Function AddFileToZip(ZipFileName As String, Filename As String)
'Zipfilename and Filename need to be full paths
  Dim oShellApp As Shell32.Shell
  Set oShellApp = CreateObject("Shell.Application")
  oShellApp.NameSpace(ZipFileName).CopyHere Filename
  Set oShellApp = Nothing
End Function

and

Function ExtractFileFromZip(ZipFileName As String, DestDir as String,Filename As String)
'Zipfilename and DestDir need to be full paths
'Filename should just be the filename without a path
  Dim oShellApp As Shell32.Shell
  Set oShellApp = CreateObject("Shell.Application")
  oShellApp.NameSpace(DestDir).CopyHere _         
oShellApp.Namespace(ZipFileName).Items.Item(Filename)
  Set oShellApp = Nothing
End Function

To extract all files replace
oShellApp.Namespace(ZipFileName).Items.Item(Filename)
with
oShellApp.Namespace(ZipFileName).Items

Note that this is a bare shell and you will need to add a bit of error checking - oShellApp 
doesn't like it if files/directories don't exist and will pop up a standard "File exists, do you 
want to copy" dialog if the zip or destination already contains the file.

-- 
Stuart