News, links, downloads, tips and tricks on Microsoft Access and related

About Me Search
Name:Alex Dybenko

Location:Moscow, Russia

Wednesday, June 11, 2008

Zip files with the default Windows XP zip program

Interesting technique - Zip file or files with the default Windows XP zip program, never thought of it, but always used 3rd party zip utilities.



Blogger grovelli said...

Ciao Alex!!! :-)
Does this technique work with VBA in Access?
I've tried
but GetOpenFileName isn't recognized as a method or data member.

10:28 PM  
Blogger Alex Dybenko said...

Ciao Giorgio!
yes, GetOpneFileName and browse for folder does not work in access, so you have to replace them with API calls like at

9:43 AM  
Blogger grovelli said...

Thank you Alex, I'm using the API described here:
but I don't understand this line:
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.XLS")
strFilter is calling itself as an argument of the ahtAddFilterItem function?!

11:43 AM  
Blogger grovelli said...

Anyway, I've tried and modified Sub Unzip2() at using the API call
but the code stops at the line
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(strInputFileName).Items
with the message 'run-time error 91 "Object variable or with block variable not set'

Here's the modified sub:
Sub Unzip2() '
Dim FSO As Object
Dim oApp As Object
Dim fname
Dim FileNameFolder
Dim DefPath As String

'fname = Application.GetOpenFileName(filefilter:="Zip Files (*.zip), *.zip", _
' MultiSelect:=False)
Dim strFilter As String
Dim strInputFileName As String

strFilter = ahtAddFilterItem(strFilter, "Zip Files (*.zip), *.zip") '
strInputFileName = ahtCommonFileOpenSave( _
Filter:=strFilter, OpenFile:=True, _
DialogTitle:="Please select an input file...", _
If strInputFileName = "" Then
'do nothing
DefPath = "C:\Test\" '<<< Change path
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If

FileNameFolder = DefPath

Set oApp = CreateObject("Shell.Application")
'Copy the files in the newly created folder
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(strInputFileName).Items

MsgBox "You find the files here: " & FileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.DeleteFolder Environ("Temp") & "\Temporary Directory*", True

Set oApp = Nothing
Set FSO = Nothing
End If
End Sub

12:58 PM  
Blogger grovelli said...

Found the solution, in the sub posted previously, I use
Dim strInputFileName
instead of
Dim strInputFileName as String

1:45 AM  
Blogger Alex Dybenko said...

Ciao Giorgio!
strFilter = ahtAddFilterItem(strFilter...
see the function - it adds filters to a string strFilter in some format, you can call it several times to add more filters

.CopyHere - i think you can try to use FileCopy

Thanks for posting!

9:06 AM  
Blogger grovelli said...

Alex, in Sub Unzip2() above, why are the lines
Set FSO = CreateObject("scripting.filesystemobject")
FSO.DeleteFolder Environ("Temp") & "\Temporary Directory*", True
used? Why do you need to delete the temporary folder?

11:26 AM  
Blogger Alex Dybenko said...

Hi Giorgio,
i do not see such line in originale code, but if you create a temp dir - then it is good idea to delete it after all

11:44 AM  
Blogger grovelli said...

Of course those lines are present in the original code. Please check

11:49 AM  
Blogger Alex Dybenko said...

ok, i looked at htm file only. no idea why he removes these temp folders, perhaps they are created automatiacally during zip process. Anyway - i would better use RmDir instead of FSO

12:05 PM  
Blogger grovelli said...

Thank you Alex, can you use the asterisk with RmDir as well?
RmDir(Environ("Temp") & "\Temporary Directory*")

12:20 PM  
Blogger Alex Dybenko said...

no, but you can use dir() for get all such directories and then run rmdir for each

12:23 PM  

Post a Comment

<< Home