Hi Ian
You can use this to get one file (ron.xlsm)
Sub Unzip1()
Dim FSO As Object
Dim oApp As Object
Dim fname
Dim FileNameFolder
Dim DefPath As String
Dim strDate As String
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
oApp.Namespace(FileNameFolder).CopyHere
oApp.Namespace(fname).Items.Item("ron.xlsm")
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