Possible way to solve this problem with multiple selections of zip files ...
Sub Unzip2()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String
Dim fileNameInZip As Variant
Dim fileno
'changed multiselect to true
Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=True)
'when error pops up when no selection is made, jump to errorhandler
'and exit this procedure
On Error GoTo ErrorStuff
'loop through selected files
For fileno = LBound(Fname) To UBound(Fname)
MsgBox Fname(fileno)
'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 & "\"
'
'MkDir FileNameFolder
'Extract the files into the newly created folder
'Set oApp = CreateObject("Shell.Application")
'added the counter to Fname -> Fname(fileno)
'For Each fileNameInZip In oApp.Namespace(Fname(fileno)).items
' If LCase(fileNameInZip) Like LCase("*.txt") Then
' oApp.Namespace(FileNameFolder).CopyHere _
' oApp.Namespace(Fname(fileno)).items.Item(CStr(fileNameInZip))
' End If
'Next
'
'Set FSO = CreateObject("scripting.filesystemobject")
'FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
Next fileno
Exit Sub
ErrorStuff:
MsgBox "No zip file picked ...", vbInformation
End Sub
Charlize