Copy Excel From Zip Folder

[SamarthSalunkhe]

I am trying to use user form for below code which one is working perfectly with cell reference for destination folder but after changing destination folder reference to Userform textbox reference it is not working.

Can someone help me in this.

Below is the original code which one is working fine.

Function ExtractZip() As Boolean
    On Error GoTo ErrorHandler
   
    Dim localZipFile As Variant
    Dim destFolder As String
    Dim ws As Worksheet
    Dim Sh As Object
    Dim zipFiles As Object
   
    Set ws = ThisWorkbook.Sheets(1)

    ' Prompt user to select the zip file
    localZipFile = Application.GetOpenFilename("Zip Files (*.zip), *.zip", , "Select Zip File")
   
    ' Check if user canceled or did not select a file
    If localZipFile = False Then
        MsgBox "No zip file selected.", vbExclamation
        ExtractZip = False
        Exit Function
    End If
   
    ' Get the destination folder path from cell A2
    destFolder = ws.Range("A2").Value
   
    If Len(destFolder) = 0 Then
        MsgBox "Error: Please provide a valid destination folder path in cell A2.", vbExclamation
        ExtractZip = False
        Exit Function
    End If
   
    ' Check if the zip file exists
    If Dir(localZipFile) = "" Then
        MsgBox "Error: The zip file specified does not have any Excel file.", vbExclamation
        ExtractZip = False
        Exit Function
    End If
   
    ' Check if there's more than one file in the zip file
    Set Sh = CreateObject("Shell.Application")
    Set zipFiles = Sh.Namespace(localZipFile).Items
    If zipFiles.Count > 1 Then
        MsgBox "Error: Multiple files found in the zip file. Please ensure only one file is present.", vbExclamation
        ExtractZip = False
        Exit Function
    End If
   
    ' Check if there's more than one file in the destination folder
    Set zipFiles = Sh.Namespace(destFolder).Items
    If zipFiles.Count > 1 Then
        MsgBox "Error: Multiple files found in the destination folder. Please ensure only one file is present.", vbExclamation
        ExtractZip = False
        Exit Function
    End If
   
    ' Extract the files from the zip file
    With Sh
        .Namespace(destFolder).CopyHere .Namespace(localZipFile).Items
    End With
   
    ExtractZip = True
    Exit Function
   
ErrorHandler:
    MsgBox "Error: " & Err.Description, vbExclamation
    ExtractZip = False
End Function

Code after changing reference of User form.

Function ExtractZip() As Boolean
   
    On Error GoTo ErrorHandler
   
    Dim localZipFile As Variant
    Dim destFolder As String
    Dim Sh As Object
    Dim zipFiles As Object
   
    ' Prompt user to select the zip file
    localZipFile = Application.GetOpenFilename("Zip Files (*.zip), *.zip", , "Select Zip File")
   
    ' Check if user canceled or did not select a file
    If localZipFile = False Then
        MsgBox "No zip file selected.", vbExclamation
        ExtractZip = False
        Exit Function
    End If
   
    ' Get the destination folder path from Textbox1
    destFolder = Trim(UserForm1.TextBox1.Value)
   
    If Len(destFolder) = 0 Then
        MsgBox "Error: Please provide a valid destination folder path in cell A2.", vbExclamation
        ExtractZip = False
        Exit Function
    End If
   
    ' Check if the zip file exists
    If Dir(localZipFile) = "" Then
        MsgBox "Error: The zip file specified does not have any Excel file.", vbExclamation
        ExtractZip = False
        Exit Function
    End If
   
    ' Check if there's more than one file in the zip file
    Set Sh = CreateObject("Shell.Application")
    Set zipFiles = Sh.Namespace(localZipFile).Items
    If zipFiles.Count > 1 Then
        MsgBox "Error: Multiple files found in the zip file. Please ensure only one file is present.", vbExclamation
        ExtractZip = False
        Exit Function
    End If
   
    ' Check if there's more than one file in the destination folder
    Set zipFiles = Sh.Namespace(destFolder).Items
    If zipFiles.Count > 1 Then
        MsgBox "Error: Multiple files found in the destination folder. Please ensure only one file is present.", vbExclamation
        ExtractZip = False
        Exit Function
    End If
   
    ' Extract the files from the zip file
    With Sh
        .Namespace(destFolder).CopyHere .Namespace(localZipFile).Items
    End With
   
    ExtractZip = True
    Exit Function
   
ErrorHandler:
    MsgBox "Error: " & Err.Description, vbExclamation
    ExtractZip = False
End Function

 

[Domenic]

When you say that it's not working, I'm not sure what you mean. Is it giving you an error? If so, which error, and on which line?

I see that while you're checking whether in fact the TextBox contains a value, you're not checking whether the path is a valid one. I would suggest that you do so before continuing with the rest of the code. So, for example, first add the following function to your module...

Function PathExists(path) As Boolean

    On Error Resume Next
    PathExists = (GetAttr(path) And vbDirectory) = vbDirectory
    
End Function

Then check for a valid path like this...

    ' Check if user path from Textbox1 is valid
    With UserForm1.TextBox1
        If Not PathExists(.Value) Then
            .SetFocus
            .SelStart = 0
            .SelLength = Len(.Value)
            MsgBox "Error: Please provide a valid destination folder path.", vbExclamation
            ExtractZip = False
            Exit Function
        End If
    End With

A couple of things, though...

1) If your code resides within the UserForm code module, you can replace each instance of UserForm1 with the keyword Me, for example destFolder = Trim(Me.TextBox1.Value) . This way, if you change the name of your UserForm, you won't need to amend your code accordingly. The keyword Me will always refer to the UserForm in which it resides.

2) If Dir(localZipFile) = "" Then will always evaluate to False, since localZipFile will always contain a valid user selected path and filename. So there's no need for this part of the code.

Hope this helps!

 

[SamarthSalunkhe]

When you say that it's not working, I'm not sure what you mean. Is it giving you an error? If so, which error, and on which line?

I see that while you're checking whether in fact the TextBox contains a value, you're not checking whether the path is a valid one. I would suggest that you do so before continuing with the rest of the code. So, for example, first add the following function to your module...

Function PathExists(path) As Boolean

    On Error Resume Next
    PathExists = (GetAttr(path) And vbDirectory) = vbDirectory
   
End Function

Then check for a valid path like this...

    ' Check if user path from Textbox1 is valid
    With UserForm1.TextBox1
        If Not PathExists(.Value) Then
            .SetFocus
            .SelStart = 0
            .SelLength = Len(.Value)
            MsgBox "Error: Please provide a valid destination folder path.", vbExclamation
            ExtractZip = False
            Exit Function
        End If
    End With

A couple of things, though...

1) If your code resides within the UserForm code module, you can replace each instance of UserForm1 with the keyword Me, for example destFolder = Trim(Me.TextBox1.Value) . This way, if you change the name of your UserForm, you won't need to amend your code accordingly. The keyword Me will always refer to the UserForm in which it resides.

2) If Dir(localZipFile) = "" Then will always evaluate to False, since localZipFile will always contain a valid user selected path and filename. So there's no need for this part of the code.

Hope this helps!

Thank you for the suggestion,

I am getting error as "Object variable or With block veriable not set" for below line.

.Namespace(destFolder).CopyHere .Namespace(localZipFile).

 

[Domenic]

It's likely because destFolder does not contain a valid path. If you amend your code as per my previous suggestion, it would check whether or not it contained a valid path. Have you done so?

 

[SamarthSalunkhe]

Tried but getting error massage "Object doesn't support this property or method."

 

[Domenic]

Can you post the exact code that you're using?

And can you confirm which line causes the error?

 

[SamarthSalunkhe]

Here is my full code, right now I am facing as error as before "Object variable or with block variable not set." I have checked everything, my path is correct modification in code is also done but no luck.

Could you please rune below code at your end, and please provide solution.

Function PathExists(path) As Boolean

    On Error Resume Next
    PathExists = (GetAttr(path) And vbDirectory) = vbDirectory
    
End Function

Sub ExtractZip12()

    Dim localZipFile As Variant
    Dim destFolder As String
    Dim Sh As Object
    Dim ws As Worksheet
    Dim zipFiles As Object
    
    ' Set the worksheet where the destination folder is located
    Set ws = ThisWorkbook.Sheets(1)

    ' Prompt user to select the zip file
    localZipFile = Application.GetOpenFilename("Zip Files (*.zip), *.zip", , "Select Zip File")
    
    ' Check if user canceled or did not select a file
    If localZipFile = False Then
        MsgBox "No zip file selected.", vbExclamation
        Exit Sub
    End If
    
    ' Get the destination folder path from the user form TextBox
    destFolder = Trim(UserForm1.TextBox1.Value)
    
    ' Check if user path from Textbox1 is valid
    With UserForm1.TextBox1
        If Not PathExists(.Value) Then
            .SetFocus
            .SelStart = 0
            .SelLength = Len(.Value)
            MsgBox "Error: Please provide a valid destination folder path.", vbExclamation
            Exit Sub
        End If
    End With
    
    ' Check if there's more than one file in the zip file
    Set Sh = CreateObject("Shell.Application")
    Set zipFiles = Sh.Namespace(localZipFile).Items
    If zipFiles.Count > 1 Then
        MsgBox "Multiple files found in the zip file. Please ensure only one file is present.", vbExclamation
        Exit Sub
    End If
    
    ' Extract the files from the zip file
    With Sh
        
        .Namespace(destFolder).CopyHere .Namespace(localZipFile).Items
    
    End With
    
    MsgBox "Zip file extracted successfully to " & destFolder, vbInformation

End Sub

 

[Domenic]

destFolder needs to be declared as a Variant...

Dim destFolder As Variant

 

[SamarthSalunkhe]

destFolder needs to be declared as a Variant...

Dim destFolder As Variant

Thank you so much for the solution it is working fine now.

 

[Domenic]

That's great, glad I could help.

Cheers!