How to Extract .zip files stored in a folder using VBA

Hi all,

Could anyone kindly help me with a VBA code which could extract all the .zip files stored in a local folder say D:\test and then delete the .zip files after extracting? I have the following files in the folder.

cm20SEP2010bhav.csv.zip
fo18SEP2009bhav.csv.zip
eq180909_csv.zip
SCBSEALL1809.zip


Regards,

Zaska

One Way:

Sub LoopFiles()
    Dim sfName As String
    Const sDir As String = "C:\ZippedFiles\"
    Const sDestination As String = "C:\Unzipped\"
    
    sfName = Dir(sDir & "*.zip")
    
    Do While Len(sfName) > 0
        zipExtract sDir & sfName, sDestination & Left(sfName, Len(sfName) - 4) & "\"
        'Kill sDir & sfName - You can uncomment this to delete the zip files once teste
        sfName = Dir
    Loop
    
End Sub


Sub zipExtract(sFilename, sDestinationDirectory)

    If Right(sDestinationDirectory, 1) <> "\" Then sDestinationDirectory = sDestinationDirectory & "\"
    On Error Resume Next
    MkDir sDestinationDirectory

    With CreateObject("Shell.Application")
        .Namespace(sDestinationDirectory).Copyhere .Namespace(sFilename).Items
    End With

End Sub

Thank you very much ..This code saved me lot of time.

If you are satisfied with the solution(s) provided, please mark your thread as Solved.


New quick method:
Select Thread Tools-> Mark thread as Solved. To undo, select Thread Tools-> Mark thread as Unsolved.

Or you can use this way:

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save