Unzip specific files with .Namespace?

T

Tom D

I have a bunch of .zip folders that I created by manually using the
built in Windows XP 'Compress (zipped) Folder' option under the 'Send
To' item on the pop-up menu associated with the folder to be compressed.
Each zipped folder contains a lot of files, but I'm only interested in
a handful from each, thus I'm wasting a lot of time waiting for the
entire folder to unzip. Is there a way to specify that I only want to
unzip certain files, such as *.txt files?

I use the .Namespace property (oApp.Namespace(DefPath).CopyHere
oApp.Namespace(Fname).items), but I can't find any documentation for it.

I don't have any other zip utilities to use, nor can I put them on my
machine.

Thanks,
Tom D
 
R

Ron de Bruin

Hi Tom

You can use this to get one file

oApp.Namespace(Fname).items.item("test.txt")

Maybe you can loop through the files and test the extension
I have no time to tes it for you now
 
T

Tom D

Ron said:
Hi Tom

You can use this to get one file

oApp.Namespace(Fname).items.item("test.txt")

Maybe you can loop through the files and test the extension
I have no time to tes it for you now
Ron,
Okay, this works: "oApp.Namespace(A).CopyHere
oApp.Namespace(B).items.item("subdirectory/test.txt")"

Is there a way to list the zip contents (I've tried several things that
didn't work)? I don't have a listing of the *.txt files.

Thanks,
Tom D
 
R

Ron de Bruin

Hi Tom

I have time tomorrow to play with it
I will see if I can find a good way
 
R

Ron de Bruin

Hi Tom

Test this one for me

Sub Unzip1()
Dim FSO As Object
Dim oApp As Object
Dim fname
Dim FileNameFolder
Dim DefPath As String
Dim strDate As String
Dim f

fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=False)
If fname = False Then
'do nothing
Else
DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If

strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"

'Create normal folder
MkDir FileNameFolder

Set oApp = CreateObject("Shell.Application")
'Copy the files in the newly created folder

For Each f In oApp.Namespace(fname).items
If f Like "*.txt" Then
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(fname).items.Item(CStr(f))
End If
Next

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
 
T

Tom D

Ron said:
Hi Tom

I update(add, the unzip page was a txt file first) both pages today
If you have problems let me know

Zip file or files with the default Windows zip program (VBA)
http://www.rondebruin.nl/windowsxpzip.htm

Unzip file or files with the default Windows zip program (VBA)
http://www.rondebruin.nl/windowsxpunzip.htm
The zip directory I'm going after contains multiple levels of
directories, each with a number of different types of files. There is no
guarantee that all file names within the zip are unique. The .CopyHere
approach works, but not CONSISTENTLY, not even with the exact same data
in a repeat experiment.

The .CopyHere a error: 'the file already exists', yet the file does NOT
exist in the target directory.

A second dialog also opens showing the progress of the copy, but of
course no progress is made. The source and target appear to be correct.

Before issuing the .CopyHere my program crawls through the zip looking
for any directories. For each directory it finds, it creates a
corresponding directory in my target folder. After that I recursively
look for files of interest in the zip and copy them over to the
appropriate directories in the target folder. The target directory
structure works out to be identical to the zip.

Here's the recursion part:
....
Sub kickItOff()
sourceFile = "C:\temp\A.zip"
targetDirectory = "C:\temp\A_new"
Call copyFromZipFile(sourceFile, targetDirectory)
MsgBox "done"
End Sub
Sub copyFromZipFile(aNamespace, targetDirectory)
Dim f
Dim oApp As Object
Dim A
Dim a1
Dim retVal
Dim a2
Dim a3

Set oApp = CreateObject("Shell.Application")

For Each f In oApp.namespace(aNamespace).items
If f.isfolder = True Then
Call copyFromZipFile(f, targetDirectory)
Else
A = f.Path
a1 = Replace(A, "/", "\") 'I've played with "/" and "\"
retVal = InStrRev(a1, "\")
a2 = Left(a1, retVal - 1) 'And with/without trailing slash

a3 = targetDirectory & "\" & a2
oApp.namespace(a3).CopyHere
oApp.namespace(aNamespace).items.Item(CStr(f))
End If
Next

Set oApp = Nothing
End Sub

Any ideas on why this should not work consistently?

Thanks,
Tom D.
 
R

Ron de Bruin

Hi Tom

It will be weekend before I have time to look at your problem and see if it
is possible with the default zip program

To busy with other things on this moment
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top