Results 1 to 8 of 8

Thread: Unzip Problem using Ron de Bruin's code

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1
    VBAX Regular
    Joined
    Mar 2009
    Posts
    37
    Location

    Unzip Problem using Ron de Bruin's code

    I'm thinking about using the following Ron de Bruin's code to unzip a specific file. But in my case I need to extract several zip files in the defined folder to respective folders without prompting to select them. Can someone help me with this please ????
             Sub Unzip2()
        Dim FSO As Object
        Dim oApp As Object
        Dim Fname As Variant
        Dim FileNameFolder As Variant
        Dim DefPath As String
        Dim strDate As String
        Dim fileNameInZip As Variant
        Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
        MultiSelect:=False)
        If Fname = False Then
            ' Do nothing
        Else
            ' Root folder for the new folder.
            ' You can also use DefPath = "C:\Users\Ron\test\"
            DefPath = Application.DefaultFilePath
            If Right(DefPath, 1) <> "\" Then
                DefPath = DefPath & "\"
            End If
            ' Create the folder name
            strDate = Format(Now, " dd-mm-yy h-mm-ss")
            FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"
            ' Make the normal folder in DefPath
            MkDir FileNameFolder
            ' Extract the files into the newly created folder
            Set oApp = CreateObject("Shell.Application")
            ' Change this "*.txt" to extract the files you want
            For Each fileNameInZip In oApp.Namespace(Fname).items
                If LCase(fileNameInZip) Like LCase("*.txt") Then
                    oApp.Namespace(FileNameFolder).CopyHere _
                    oApp.Namespace(Fname).items.Item(CStr(fileNameInZip))
                End If
            Next
            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
    Last edited by Aussiebear; 04-15-2025 at 05:55 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •