Send to Compressed Folder

[Jim Franklin]

Hi,

Can anyone tell me if there is a way of replicating the Send To > Compressed
(zipped) folder function that is available in explorer from within my Access
vba code?

My program will operate in an Access2003 / Windows XP environment.

Thanks,

Jim

 

[Jim Franklin]

Hi All,

Actually I think I have found the answer to my own question (for once!) But
in case anyone else wants to do the same thing, the following bit of code is
my adaptation of something posted by Ron de Bruin.

Sub Zip_BackEnd()

Dim strMDBFile
Dim strZIPFile
Dim oApp As Object

strMDBFile = "C:\Test.mdb"
strZIPFile = Left(strMDBFile, Len(strMDBFile) - 4) & ".zip"

If Dir(strZIPFile) <> "" Then
'zip file already exists, so delete first
Kill strZIPFile
'hold up processing until zip file deleted
Do Until Dir(strZIPFile) = ""
Loop
End If

If Dir(strZIPFile) = "" Then
'Create empty Zip File
NewZip (strZIPFile)

'Copy the file in the compressed folder
Set oApp = CreateObject("Shell.Application")
oApp.NameSpace(strZIPFile).CopyHere strMDBFile

'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.NameSpace(strZIPFile).items.Count = 1
Loop
End If

End Sub



Sub NewZip(sPath)
'Create empty Zip File
'Changed by keepITcool Dec-12-2005
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

Hope this helps someone!
Jim