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

jerry12302

Active Member
Joined
Apr 18, 2005
Messages
456
Office Version
  1. 2010
Platform
  1. Windows
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?

VBA Code:
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
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Change this line to:
VBA Code:
oApp.Namespace(FilePath).CopyHere oApp.Namespace(FileName).Items, 4 + 8 + 16
To overwrite use: 4 + 16
Link for parameters: LINK
 
Upvote 0
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?
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,223,098
Messages
6,170,099
Members
452,301
Latest member
QualityAssurance

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top