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