none
extract single file from zipped folder RRS feed

  • Question

  • Ok, it's been a few days, and it's clear I've made this too comprehensive. Please forgive me. 

    So, please allow me to break it down into parts.

    First, I've found Ron Debruin's zip macro which allows for file extraction from a zip file. It does not however work with extracting anything except text files. I did change the file format to pdf, but never got a positive result. 

    http://www.rondebruin.nl/win/s7/win002.htm

    I've tried both examples 1 and 2. Example 2 appears to do more of what I'm wanting-- extract a single file.

    From Ron's code:

    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

    Within the line:

     If LCase(fileNameInZip) Like LCase("*.txt")

    I changed the *.txt to *.pdf. I did not obtain the results that I'd wanted. 

    What would I need to extract a single pdf, or rtf file from the zip file? 

    TYIA

    Wednesday, August 26, 2015 9:26 PM

Answers

  • By way of an update, I found what I wanted (This is a modification of Example 2 on the above linked page). I.e., this phase is answered. 

    Talking back and forth with Ron DeBruin-- not waiting for his answers at a certain point-- I found a solution that does what I want for this part. 

    Sub Unzip2A()
        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
        Dim fileNameInZip1 As Variant
        Dim FName1 As Variant
     'modified for my purposes. (C) August 2015
     'Original code by Ron deBruin, out of the Netherlands.
    
        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 & "PO's " & strDate & "\"
    
            'Make the normal folder in DefPath
            MkDir FileNameFolder
    Set FSO = CreateObject("scripting.filesystemobject")
        FSO.GetBaseName (Fname)
        
        'doubled up on variables at this point. Assigned FName to the value of FName1.
        
       FName1 = FSO.GetBaseName(Fname)
            '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
            fileNameInZip1 = FSO.GetBaseName(fileNameInZip)
            
            'assigned fileNameInZip to fileNameInZip1, and did a right side comparison. Where there were multiple file
            'types in zip folder, it extracted all similarly named files, leaving other files alone.
            'Which is good enough for what I wanted.
            
                If LCase(Right(fileNameInZip1, 8)) Like LCase(Right(FName1, 8)) 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

    This extracts the files which will match the right 8 characters of the file name, and is part of the zipped folder's name, irrespective of the file extension. Which means that you can use Left, Mid, or Right to compare file names. 

    I also found that Object.GetBaseName(Path) works easier than the standard drop file extension code. 

    https://msdn.microsoft.com/en-us/library/office/gg264113.aspx?f=255&MSPPError=-2147217396

    I also found that the macro won't work if your "view file extensions" is not set to view. Did not consider that before.

    Have a great day all.

    Best. 

    • Marked as answer by SteveDB1 Wednesday, August 26, 2015 11:19 PM
    Wednesday, August 26, 2015 11:19 PM

All replies

  • By way of an update, I found what I wanted (This is a modification of Example 2 on the above linked page). I.e., this phase is answered. 

    Talking back and forth with Ron DeBruin-- not waiting for his answers at a certain point-- I found a solution that does what I want for this part. 

    Sub Unzip2A()
        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
        Dim fileNameInZip1 As Variant
        Dim FName1 As Variant
     'modified for my purposes. (C) August 2015
     'Original code by Ron deBruin, out of the Netherlands.
    
        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 & "PO's " & strDate & "\"
    
            'Make the normal folder in DefPath
            MkDir FileNameFolder
    Set FSO = CreateObject("scripting.filesystemobject")
        FSO.GetBaseName (Fname)
        
        'doubled up on variables at this point. Assigned FName to the value of FName1.
        
       FName1 = FSO.GetBaseName(Fname)
            '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
            fileNameInZip1 = FSO.GetBaseName(fileNameInZip)
            
            'assigned fileNameInZip to fileNameInZip1, and did a right side comparison. Where there were multiple file
            'types in zip folder, it extracted all similarly named files, leaving other files alone.
            'Which is good enough for what I wanted.
            
                If LCase(Right(fileNameInZip1, 8)) Like LCase(Right(FName1, 8)) 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

    This extracts the files which will match the right 8 characters of the file name, and is part of the zipped folder's name, irrespective of the file extension. Which means that you can use Left, Mid, or Right to compare file names. 

    I also found that Object.GetBaseName(Path) works easier than the standard drop file extension code. 

    https://msdn.microsoft.com/en-us/library/office/gg264113.aspx?f=255&MSPPError=-2147217396

    I also found that the macro won't work if your "view file extensions" is not set to view. Did not consider that before.

    Have a great day all.

    Best. 

    • Marked as answer by SteveDB1 Wednesday, August 26, 2015 11:19 PM
    Wednesday, August 26, 2015 11:19 PM
  • Hi,

    Thanks for sharing your solution.

    Regards

    Starain


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Thursday, August 27, 2015 1:42 AM
    Moderator