[AccessD] ZIpping Files

Stuart,
What sort of thing would you use this for?  Would it be to archive stuff,
mail stuff, that sort of thing? Or is there something more intrinsic to
Access that I am not grasping?
Thanks
Max


-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Stuart McLachlan
Sent: 17 February 2009 14:46
To: Access Developers discussion and problem solving
Subject: [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
-- 
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com