Use Excel VBA to unzip files

Question

I found this code on another stack overflow post and it works well but the code prompts the user to select the file, can it be changed so that it automatically unzips all the files in the chosen directory?

Unzip folder with files to the chosen location

Sub Unzip()
    Dim FSO As Object
    Dim oApp As Object
    Dim Fname As Variant
    Dim FileNameFolder As Variant
    Dim DefPath As String

    Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
                                        MultiSelect:=False)
    If Fname = False Then
        'Do nothing
    Else
        'Destination folder
        DefPath = "C:\test\"    ' Change to your path / variable
        If Right(DefPath, 1) <> "\" Then
            DefPath = DefPath & "\"
        End If

        FileNameFolder = DefPath

        '        'Delete all the files in the folder DefPath first if you want
        '        On Error Resume Next
        '        Kill DefPath & "*.*"
        '        On Error GoTo 0

        'Extract the files into the Destination folder
        Set oApp = CreateObject("Shell.Application")
        oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items

        MsgBox "You find the files here: " & FileNameFolder

        On Error Resume Next
        Set FSO = CreateObject("scripting.filesystemobject")
        FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
    End If
End Sub

Now with an added loop as brax is great to point out that I can use this but still doesn't solve the issue of the user being prompted for which file to open

Sub Unzip5()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String

Dim StrFile As String
StrFile = Dir("Z:\G Thang\Excel & VBA\Extract\*.zip")
Do While Len(StrFile) > 0

Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
                        MultiSelect:=False)
If Fname = False Then
'Do nothing
Else
'Destination folder
DefPath = "Z:\G Thang\Excel & VBA\Extract\" ' Change to your path / variable
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
FileNameFolder = DefPath
' 'Delete all the files in the folder DefPath first if you want
' On Error Resume Next
' Kill DefPath & "*.*"
' On Error GoTo 0
'Extract the files into the Destination folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
MsgBox "You find the files here: " & FileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True

End If

Loop

End Sub

ok, I'm getting it! But my new code loops through the same file and keeps unzipping that one, maybe I can move it into another directory when I've finished unzipping it and then move onto the next one, i'll post the code below.

Sub Unzip99File()


Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim StrFile As String

StrFile = Dir("Z:\G Thang\Excel & VBA\Extract\*.zip")
'Fname = ("*.zip")
    Do While Len(StrFile) > 0
    
        Fname = ("*.zip")
        
            If Fname = False Then                           'Fname
                'Do nothing
                Else
                'Destination folder
                DefPath = "Z:\G Thang\Excel & VBA\Extract\" ' Change to your path / variable
              '  If Right(DefPath, 1) <> "\" Then
               ' DefPath = DefPath & "\"
                ' End If
        FileNameFolder = DefPath
        ' 'Delete all the files in the folder DefPath first if you want
        ' On Error Resume Next
        ' Kill DefPath & "*.*"
        ' On Error GoTo 0
        
        'Extract the files into the Destination folder
        Set oApp = CreateObject("Shell.Application")
        oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(DefPath & StrFile).items

        On Error Resume Next
        Set FSO = CreateObject("scripting.filesystemobject")
        FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
        
        End If
    
    Loop

End Sub

https://stackoverflow.com/questions/10380312/loop-through-files-in-a-folder-using-vba — braX, Jul 09 '20 at 12:53
great thanks brax, how do i incorporate that into to above code? sorry, still a bit of a nube — Timmay, Jul 09 '20 at 21:48
You just make a loop like it shows, and put the part you have inside the loop, substituting the filename for the loop variable — braX, Jul 09 '20 at 22:08
ok, I think I worked that out but still doesn't solve the issue that the macro keeps prompting the user for which file to unzip, ideally I'd really like it to unzip everything in the directory, I've added the the updated code to the question above — Timmay, Jul 10 '20 at 08:18
The line that is causing the prompt is the `Fname = Application.GetOpenFilename` - remove that line, and assign that variable using the loop variable instead. — braX, Jul 10 '20 at 08:22
ok, I'm getting it! But my new code loops through the same file and keeps unzipping that one, maybe I can move it into another directory when I've finished unzipping it and then move onto the next one, i'll post the code above — Timmay, Jul 10 '20 at 09:51

Use Excel VBA to unzip files

0 Answers0