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 he " & 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

--

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


"Ron de Bruin" wrote in message ...
Hi Tom

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



--

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


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