Unzip Problem using Ron de Bruin's code

[Dave]

This seems to work. HTH. Dave

 
Sub FolderFiles()
    ' unzip all zipped files in folder
    Dim FolderPath As String, AllZip As String
    FolderPath = "D:\testfolder" 'folder containing zip files
    AllZip = Dir(FolderPath & "\*.zip")
    Do While AllZip <> ""
        Call Unzip(FolderPath & "\", FolderPath & "\" & AllZip)
        AllZip = Dir
    Loop
End Sub
 
Public Function Unzip(DefPath, Fname)
    ' Many thanks to Ron de Bruin for his great code
    ' Unzips A File
    ' Fname must be FULL Path\Filename.zip
    ' DefPath must be valid Path you want to Unzip file TO
    ' You just need to pass 2 strings.
    ' C:\FullPath\Filename.zip - the file to UNZIP
    ' C:\FullPath\ - folder to unzip to
    Dim FSO As Object
    Dim oApp As Object
    Set oApp = CreateObject("Shell.Application")
    oApp.Namespace(DefPath).CopyHere oApp.Namespace(Fname).items
    On Error Resume Next
    Set FSO = CreateObject("scripting.filesystemobject")
    FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
    Set FSO = Nothing
    Set oApp = Nothing
End Function