How to copy /unzipped files within zip files to existing folder

[ryan8200]

Hi All,

I have 2 zip folders in current directory. I want to copy all csv files within the zip folder to current directory (same directory with zip folders). I try the following code but it only copy zip folder and not csv files within the zip folder. Kindly assist. Thanks.

Sub Unzipfiles()
Dim sh As New Shell32.Shell

Path = "C:\Users\My\Downloads\"
Filename = Dir(Path & "*.zip")

' Disable Screen Updating is used to stop screen flickering and Disable Events is used to avoid interrupted dialog boxes / popups
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

  Do While Filename <> ""
     Filename = Dir()
  Loop
  
  'Destination & Source Path
  sh.Namespace(Path).CopyHere _
    sh.Namespace(Path & Filename).Items, 16

End Sub

 

[rollis13]

Maybe:

Option Explicit
Sub UnzipAFile()     ' Unzip a zip file to a folder
    'Declare variables
    Dim sh     As Object
    Dim Filename As Variant, Path As Variant
    ' Disable Screen Updating is used to stop screen flickering and Disable Events is used to avoid interrupted dialog boxes / popups
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set sh = CreateObject("Shell.Application")
    Path = "C:\Users\My\Downloads\"
    Filename = Dir(Path & "*.zip")
    Do While Filename <> ""
        ' Destination & Source Path
        sh.Namespace(Path).CopyHere sh.Namespace(Path & Filename).Items
        Filename = Dir()
    Loop
    ' Resume Screen Updating and Events
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Set sh = Nothing
    MsgBox "Done!"
End Sub

 

[ryan8200]

Maybe:

Option Explicit
Sub UnzipAFile()     ' Unzip a zip file to a folder
    'Declare variables
    Dim sh     As Object
    Dim Filename As Variant, Path As Variant
    ' Disable Screen Updating is used to stop screen flickering and Disable Events is used to avoid interrupted dialog boxes / popups
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set sh = CreateObject("Shell.Application")
    Path = "C:\Users\My\Downloads\"
    Filename = Dir(Path & "*.zip")
    Do While Filename <> ""
        ' Destination & Source Path
        sh.Namespace(Path).CopyHere sh.Namespace(Path & Filename).Items
        Filename = Dir()
    Loop
    ' Resume Screen Updating and Events
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Set sh = Nothing
    MsgBox "Done!"
End Sub

Hi Rollis13,
Thanks for your input. Your code really work in some extent. How to enhance the above code, so that it will copy csv files contains inside multiple folders within each zip folder ?

 

[rollis13]

Do you mean that inside the zipped file you have .cvs files and other zipped files ? or do you mean that inside the zipped file you have .cvs files and other folders that contain other .cvs files ?

 

[ryan8200]

Do you mean that inside the zipped file you have .cvs files and other zipped files ? or do you mean that inside the zipped file you have .cvs files and other folders that contain other .cvs files ?

Inside the zipped file have .cvs files and other folders that contain other .cvs files

 

[rollis13]

Have a try:

Option Explicit
Sub UnzipAFile_new()
    Dim Filename As Variant, Path As Variant
    Dim sh     As Object
    Dim fso    As Object, SubFldr As Object
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set sh = CreateObject("Shell.Application")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Path = "C:\Users\My\Downloads\"
    Filename = Dir(Path & "*.zip")
    'unzip zip files to a folder (files & subfolders)
    Do While Filename <> ""
        sh.Namespace(Path).CopyHere sh.Namespace(Path & Filename).Items
        DoEvents
        Filename = Dir()
    Loop
    'copy files from subfolders to folder
    For Each SubFldr In fso.GetFolder(Path).SubFolders
        fso.CopyFile Source:=SubFldr & "\" & "*.csv", Destination:=Path
    Next
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Set sh = Nothing
    Set fso = Nothing
    MsgBox "Done!"
End Sub