Prevent Windows popup options when copying or extracting files that already exist in the folder. (Force Copy and Replace, or other options)

[jerry12302]

I have a macro that extracts files from .zip files in a selected folder. The files are extracted to folders that may already have certain files with the same file names. When this occurs I get a Windows popup alert with options to "Copy and Replace", "Don't Copy", or "Copy, but keep both files". This can occur a hundred or more times during one macro run, is there a way to prevent this popup and force one of the options, like "Copy, but keep both files"?

Application.DisplayAlerts = False does not work in this context, I already tried that. Any ideas?

Sub Unzip_Files(MyFolder)
    
    'Extract files from all .zip files that are in a selected folder.
    'Folder name is stored in MyFolder, passed here from another routine
    'where the folder was selected.
    
    Dim NumRows, c, r As Integer
    Dim MyFile As String
    Dim FilePath As String
    Dim FilePathExists As String
    Dim FileName As String
    Dim oApp As Shell
    
    'Create necessary extract folders, where files are to be extracted.
    'Extract folders are based on name of zip file, = first 16 characters.
    'Column B contains the list of all zip files in the folder.
    
    NumRows = Range("B1").End(xlDown).Row
    If NumRows <= 2 Then
        MsgBox "No zip files, ending macro"
        End
    End If
    
    'Number of rows to loop through.
    c = 2 'Column 2 (B).
    r = 3 'Start at row 3, rows 1 and 2 are column descriptions.
    Do While r <= NumRows
        MyFile = Cells(r, c) 'Get the zip file name from the list.
        FilePath = MyFolder & "\" & Left(MyFile, 16) 'The extract folder name.
        'Test if extract folder exists, if not then create it.
        FilePathExists = Dir(FilePath, vbDirectory)
        If FilePathExists = "" Then
            MkDir FilePath
        End If
        r = r + 1
    Loop
    
    'Extract files to correct extract folders:
    
    Application.DisplayAlerts = False 'DOES NOT PREVENT WINDOWS POPUP WHEN FILE EXISTS
    
    'Create array of all .zip files.
    MyFile = Dir(MyFolder & "\*.zip")

    Do While Len(MyFile) > 0
        'Filename is the zip file name, = folder & current zip file in list,
        'this is the .zip file containing files to be extracted.
        FileName = MyFolder & "\" & MyFile
        
        'FilePath is the extract folder, where files are to be extracted, =
        'folder & left 16 characters of the current zip file in list.
        FilePath = MyFolder & "\" & Left(MyFile, 16)
        
        'Extract files.
        Set oApp = CreateObject("Shell.Application")
        oApp.Namespace(FilePath).CopyHere oApp.Namespace(FileName).Items
        MyFile = Dir
    Loop
    
    Application.DisplayAlerts = True
    
End Sub

 

[rollis13]

Change this line to:

oApp.Namespace(FilePath).CopyHere oApp.Namespace(FileName).Items, 4 + 8 + 16

To overwrite use: 4 + 16
Link for parameters: LINK

 

[jerry12302]

Thank you for the reply.

I used 4 + 8 + 16, there was no popup so it kept running, but it did not keep both files, it overwrote all the files.

I see the description in the link says...

(4)

Do not display a progress dialog box.

(8)

Give the file being operated on a new name in a move, copy, or rename operation if a file with the target name already exists.

(16)

Respond with "Yes to All" for any dialog box that is displayed.

So I would have thought that would work, but it did not create a second file name with the expected suffix, like (2) at the end.

I also tried just 4 + 16 just to see what it would do, and it did the same thing, no second files either.

Any other ideas?

 

[rollis13]

Sorry, but in my test macro 4+8+16 does it's job ( (2) at the end ) while 4+16 overwrites. Do some debugging with key F8 and check the values of variables.

 

[jerry12302]

It appears it has to do with extracting files from a .zip file, vs. copying or moving files from one folder to another. I didn't notice this message from your link before....

----------------------
Note

In some cases, such as compressed (.zip) files, some option flags may be ignored by design.
----------------------

I ended up writing a work around, to create a new temporary folder and extract all the files there, then I can use easier code to simply move those files to the actual target folders and either overwrite existing files by first finding and killing any duplicates, or keep the original and move the duplicate file with a (2) suffix in the file name.

 

[rollis13]

Glad you found a different solution, but

but in my test macro 4+8+16 does it's job

my suggestion is working with .ZIP files .