Unzip folder with files to the chosen location

Question

Team, I am working upon extract the zip file from VBA code but getting error, here is my code:

Sub Un_Zip_File()
Dim flname As String
Call PathCall
flname = Dir(impathn & "Transactions*.zip")
Call PathCall
Call UnZip_File(impathn, flname)
End Sub

Sub UnZip_File(strTargetPath As String, fname As Variant)
Dim oApp As Object, FSOobj As Object
Dim FileNameFolder As Variant

If Right(strTargetPath, 1) <> Application.PathSeparator Then
strTargetPath = strTargetPath & Application.PathSeparator
End If

FileNameFolder = strTargetPath

'destination folder if it does not exist
Set FSOobj = CreateObject("Scripting.FilesystemObject")
If FSOobj.FolderExists(FileNameFolder) = False Then
FSOobj.CreateFolder FileNameFolder
End If

Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(fname).Items

Set oApp = Nothing
Set FSOobj = Nothing
Set FileNameFolder = Nothing

End Sub

When I am running Un_zip_file macro, I am getting error:

Object variables or with block variable not set

after debug moving on

oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(fname).Items

Answer 1

Here is another example how to unzip a file.
the macro unzip the zip file in a fixed folder"C:\test\"

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

Answer 2

Found elsewhere on the web and thought it might help here...

Sub UnzipAFile(zippedFileFullName As Variant, unzipToPath As Variant)

Dim ShellApp As Object

'Copy the files & folders from the zip into a folder
Set ShellApp = CreateObject("Shell.Application")
On Error Resume Next
ShellApp.Namespace(unzipToPath).CopyHere ShellApp.Namespace(zippedFileFullName).Items
On Error GoTo 0
End Sub

Answer 3

I had same error "Object variables or with block variable not set".

Solved it by adding reference to "Microsoft Shell Controls & Automation" - Shell32.dll. Then define & use the Shell object in this order.

Do not skip any of these steps. I have also posted full code in this page.

Dim wShApp As Shell

Set wShApp = CreateObject("Shell.Application")
Set objZipItems = wShApp.Namespace(zipFileName).items  

wShApp.Namespace(unZipFolderName).CopyHere objZipItems