Extract Zip

[prasadgov]

Hi,

I am trying to extract the contents of a zip file into another folder while saving them as .txt files.
But where the code is bold, it says "the Zip file could not not be opened."

 Function ExtractZipAndSaveAsTxt(zipFilePath As String, destinationFolder As String)
    
    Dim shellApp As Object
    Dim zipFolder As Object
    Dim fileItem As Object
    Dim extractedFilePath As String
    
    ' Create Shell object
    Set shellApp = CreateObject("Shell.Application")
    ' Open the ZIP file
    Set zipFolder = shellApp.Namespace(zipFilePath)
    If Not zipFolder Is Nothing Then
    ' Loop through each item in the ZIP file
    For Each fileItem In zipFolder.Items
    ' Extract the file to the destination folder
    shellApp.Namespace(destinationFolder).CopyHere fileItem
    ' Construct the path for the extracted file
    extractedFilePath = destinationFolder & "\" & fileItem.Name
    ' Check if the extracted file is a text file
    If InStr(fileItem.Name, ".txt") > 0 Then
    Debug.Print "Extracted and saved as: " & extractedFilePath
    End If
    Next fileItem
    Else
    MsgBox "The ZIP file could not be opened.", vbCritical
    End If
    
    ' Clean up
    Set zipFolder = Nothing
    Set shellApp = Nothing
    
    End Function

and I call it from

Private Sub cmdExtractZip_Click()
    Dim zipPath As String
    Dim extractPath As String
    
    zipPath = "S:\IT\GP\240703.zip"
    extractPath = "S:\IT\GP\ReportFiles\"
    ExtractZipAndSaveAsTxt zipPath, extractPath
End Sub

The references are all good since when I compile it, i do not get any errors.

TIA

 

[June7]

Is it a Windows Compression .zip file?
From my procedure:

        'Extract the files into the Destination folder
        Set oApp = CreateObject("Shell.Application")
        oApp.NameSpace(FileNameFolder).CopyHere oApp.NameSpace(fName).Items

 

[Gasman]

No code in bold?

 

[prasadgov]

No code in bold?

These two lines

Set zipFolder = shellApp.Namespace(zipFilePath)
If Not zipFolder Is Nothing Then

The error is "the Zip file could not not be opened."

 

[prasadgov]

Is it a Windows Compression .zip file?
From my procedure:

        'Extract the files into the Destination folder
        Set oApp = CreateObject("Shell.Application")
        oApp.NameSpace(FileNameFolder).CopyHere oApp.NameSpace(fName).Items

it says Object variable or with variable not set

Set shellApp = CreateObject("Shell.Application")
' Open the ZIP file
'Set zipFolder = shellApp.Namespace(zipFilePath)
shellApp.NameSpace(zipFilePath).CopyHere shellApp.NameSpace(fileItem).Items

 

[prasadgov]

I modified my code and I am able to extract

 

[Eugene-LS]

But where the code is bold, it says "the Zip file could not not be opened."

Try:

Function ExtractZipAndSaveAsTxt(zipFilePath As String, destinationFolder As String)
Dim shellApp As Object
Dim zipFolder As Object
Dim fileItem As Object
Dim extractedFilePath As String
  
' Create Shell object
    Set shellApp = CreateObject("Shell.Application")
' Open the ZIP file
    Set zipFolder = shellApp.Namespace((zipFilePath))
  
    If Not zipFolder Is Nothing Then
    ' Loop through each item in the ZIP file
        For Each fileItem In zipFolder.Items
        ' Extract the file to the destination folder
            shellApp.Namespace((destinationFolder)).CopyHere fileItem
            ' Construct the path for the extracted file
            extractedFilePath = destinationFolder & "\" & fileItem.Name
            ' Check if the extracted file is a text file
            If InStr(fileItem.Name, ".txt") > 0 Then
                Debug.Print "Extracted and saved as: " & extractedFilePath
            End If
        Next fileItem
    Else
        MsgBox "The ZIP file could not be opened.", vbCritical
    End If
 
' Clean up
    Set zipFolder = Nothing
    Set shellApp = Nothing
  
End Function

I use the code below:

Public Sub UnZip(ByVal zipArchivePath As String, ByVal extractToFolder As String)
   
    Dim SH As Object
    Dim fSource As Object
    Dim fTarget As Object
   
    Set SH = CreateObject("Shell.Application")

    Set fSource = SH.Namespace((zipArchivePath))
    Set fTarget = SH.Namespace((extractToFolder))
   
    fTarget.CopyHere fSource.Items
   
End Sub