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

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Tom D" wrote in message ...
Ron de Bruin wrote:
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.