[AccessD] Cannot CreateOutout File

On 6 Feb 2012 at 8:48, Stuart McLachlan wrote:
> 
> I posted some VBA a long time ago to do this directly, I'll see if I can find it.
> 

Found it - originally posted by me 18 Feb 2009:

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.