VBA: pre-select answer to override file

[Adar123]

Hi all,

My macro involves files extraction from zip and saving under a specified name. If I was to rerun the macro, I am being told that the file with such name existing and asking whether we should replace it?

Can I pre-select the answer in VBA, so that I don't need to click "Yes" and "Copy and Replace" every time?

Thank you.

Saving over:

Set wkBk = ActiveWorkbook

wkBk.Sheets("1").Copy

ActiveWorkbook.SaveAs "location"
ActiveWorkbook.SaveAs "location 2"
ActiveWorkbook.Close

Unzipping:

Set Sh = CreateObject("Shell.Application")
With Sh
        
.Namespace(destFolder).CopyHere .Namespace(localZipFile).Items
End With

Set myApp = CreateObject("Excel.Application")

 

[Logit]

Try adding this at the beginning of your sub : Application.DisplayAlerts = False

Then as the last line in your macro : Application.DisplayAlerts = True

 

[Adar123]

Thank you, this solves one of two, so is an improvement: whenever I need overwrite a workbook, the message is not popping out anymore. However, for the unzipping part, I am still required to choose the action: "copy & replace" or "don't copy" or "copy, but keep both files"

 

[Logit]

Are you using a Third Party software to perform the unzipping ? If so, the message would be part of that software and I do not know of a way to prevent
those messages.

 

[Adar123]

Can Excel unzip without a WinZip or equivalent software? Haven't really thought about it.
The code is as is above, I am not pointing it to use any specific software. The error as the screenshot suggests appears in Excel environment.

 

[Logit]

I recall having a macro on my toolbox that will do that. Problem, I am on a business trip and won't return until next week. If u don't have an answer by then ill respond.

 

[Logit]

Sub UnzipFiles()
Dim myfolder
Dim destfolder

With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    myfolder = .SelectedItems(1) & "\"
End With

With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    destfolder = .SelectedItems(1) & "\"
End With

Call Recursive(myfolder, destfolder)

End Sub

Sub Recursive(FolderPath As Variant, destfolder As Variant)
Dim Value As String, Folders() As String
Dim Folder As Variant, a As Long
Dim SApp As Object

ReDim Folders(0)

If Right(FolderPath, 2) = "\\" Then Exit Sub
Value = Dir(FolderPath, &H1F)

Do Until Value = ""
    If Value = "." Or Value = ".." Then
    Else
        If GetAttr(FolderPath & Value) = 16 Or GetAttr(FolderPath & Value) = 48 Then
            Folders(UBound(Folders)) = Value
            ReDim Preserve Folders(UBound(Folders) + 1)
        Else
            If Right(Value, 4) = ".zip" Then
                Set SApp = CreateObject("Shell.Application")
                SApp.Namespace(destfolder).CopyHere _
                SApp.Namespace(FolderPath & Value).items
            End If
        End If
    End If
    Value = Dir
Loop

For Each Folder In Folders
    Call Recursive(FolderPath & Folder & "\", destfolder)
Next Folder

End Sub

I re-tested this to be certain it works as it should. The ZIP file was located in my DOWNLOADS folder.

As you will see the FileDialog window opens but with the present coding it won't let you specifically choose a ZIP file. The zip file I had in my Downloads
folder was the only one sitting there. It unzipped the files accurately after asking for the folder location the files should be unzipped to.

Hopefully you can work with the existing code and modify it for your needs.

 

[Logit]

This project will ZIP all files in a folder you select :

Option Explicit

Sub Zip_File_Or_Files()
    Dim strDate As String, DefPath As String, sFName As String
    Dim oApp As Object, iCtr As Long, I As Integer
    Dim FName, vArr, FileNameZip
      
    DefPath = Application.DefaultFilePath
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If

    strDate = Format(Now, " dd-mmm-yy h-mm-ss")
    FileNameZip = DefPath & "MyFilesZip " & strDate & ".zip"

    'Browse to the file(s), use the Ctrl key to select more files
    FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", _
                    MultiSelect:=True, Title:="Select the files you want to zip")
    If IsArray(FName) = False Then
        'do nothing
    Else
        'Create empty Zip File
        NewZip (FileNameZip)
        Set oApp = CreateObject("Shell.Application")
        I = 0
        For iCtr = LBound(FName) To UBound(FName)
            vArr = Split97(FName(iCtr), "\")
            sFName = vArr(UBound(vArr))
            If bIsBookOpen(sFName) Then
                MsgBox "You can't zip a file that is open!" & vbLf & _
                       "Please close it and try again: " & FName(iCtr)
            Else
                'Copy the file to the compressed folder
                I = I + 1
                oApp.Namespace(FileNameZip).CopyHere FName(iCtr)

                'Keep script waiting until Compressing is done
                On Error Resume Next
                Do Until oApp.Namespace(FileNameZip).items.Count = I
                    Application.Wait (Now + TimeValue("0:00:01"))
                Loop
                On Error GoTo 0
            End If
        Next iCtr

        MsgBox "You find the zipfile here: " & FileNameZip
    End If
End Sub

Sub NewZip(sPath)
'Create empty Zip File
'Changed by keepITcool Dec-12-2005
    If Len(Dir(sPath)) > 0 Then Kill sPath
    Open sPath For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
End Sub


Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
    On Error Resume Next
    bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function


Function Split97(sStr As Variant, sdelim As String) As Variant
'Tom Ogilvy
    Split97 = Evaluate("{""" & _
                       Application.Substitute(sStr, sdelim, """,""") & """}")
End Function

 

[Adar123]

Thanks for sharing.

I will look into this code.