Unzip File using VBA (Visual Basic for Application) example

Unzip

Process of extract zipped contents to make accessible to the end user called Unzip. In this article we will write code to unzip file.

Code example

Public Sub UnZipCodeExample()
On Error GoTo errh
    Dim FSO As Object
    Dim oShellApp As Object
    Dim oFileToBeExtracted As Variant
    Dim oZipFileFolderName As Variant
    Dim oDirectoryPath As String
    
    'Pick a file
    oFileToBeExtracted = Application.GetOpenFilename(FileFilter:="Zip Files (*.zip), *.zip", _
                                        MultiSelect:=False, Title:="VBAOVERALL- Select a Zip File")
    If oFileToBeExtracted = False Then
        MsgBox "Please select a file", vbInformation, "VBAOVERALL Info"
        Exit Sub
    Else
        'verify folder.
        oDirectoryPath = Application.DefaultFilePath
        If Right(oDirectoryPath, 1) <> "\" Then
            oDirectoryPath = oDirectoryPath & "\"
        End If
        
        'Generate unique id
        Dim GUID As String
        GUID = GenrateShortGuid
            
        'Create the folder name
        oZipFileFolderName = oDirectoryPath & "UnzipFolder " & GUID & "\"

        'Create folder
        MkDir oZipFileFolderName

        'Declare shell application
        Set oShellApp = CreateObject("Shell.Application")
        
        'Extract files into the newly created folder
        oShellApp.Namespace(oZipFileFolderName).CopyHere oShellApp.Namespace(oFileToBeExtracted).items
        
        'write output
        Range("Output") = zipFileName
        Range("Output").Hyperlinks.Add Anchor:=Range("Output"), Address:=oZipFileFolderName, ScreenTip:="Click to open zip file"
        MsgBox "File extracted successfully!!!", vbInformation, "VBAOVERALL - Info"

        On Error Resume Next
        Set FSO = CreateObject("scripting.filesystemobject")
        FSO.DeleteFolder Environ("Temp") & "\Temporary Directory*", True
    End If
    'cleanup
    If Not FSO Is Nothing Then
        Set FSO = Nothing
    End If
errh:
If Err.Number <> 0 Then
    MsgBox "Opration fail due to : " & Err.Description
    Exit Sub
End If
End Sub

GenrateShortGuid function

Function GenrateShortGuid() As String
  GenrateShortGuid = ""
  Dim oLib As Object
  Dim GUID As String
  Dim guid2 As String
  Set oLib = CreateObject("Scriptlet.TypeLib")
  GUID = Left$(oLib.GUID, 38)
  Set TypeLib = Nothing
  
  GUID = Replace(GUID, "{", "")
  GUID = Replace(GUID, "}", "")
  GUID = Split(GUID, "-")(0)
  'Return result
  GenrateShortGuid = GUID
End Function

Output

Next >> How to Zip File(s) using VBA (Visual Basic for Applications) code

Share on Facebook

Tweet