[AccessD] Cannot CreateOutout File

FWIW, here`s a blog post that popped up today about zipping from VBA:

http://accessexperts.net/blog/2012/02/06/zipandunzipfrommicrosoftvba

Doug

On Sun, Feb 5, 2012 at 2:53 PM, Stuart McLachlan <stuart at lexacorp.com.pg>wrote:

> 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.
>
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>