CODEWITHSUNDEEP
excelvbashellzip
justkrys
justkrys

Reputation: 300

vba copying and replacing files in zip folder

I have created a VBA macro that pulls files from folder/subfolders based on a number of parameters. This includes finding zip folders that meet those parameters and copying them to a new directory so that each file can be searched through also. The problem that I'm having is that many of the files in those zips are duplicates, and as the project is to be automated, I cannot sit there and push the don't copy button every time it pops up. Is there a way to search through zip files and ignore the duplicate files? What I have for this part of my code is:

Sub Unzip(fileName As String, mainSubfolder As String)

Dim sourceDir As String, fileString As String
Dim FileNameFolder As Variant
Dim oApp As Object

sourceDir = "\\Filesrv02\depts\AR\EDIfiles\Remits"
fileString = mainSubfolder + fileName

    If Right(sourceDir, 1) <> "\" Then
        sourceDir = sourceDir & "\"
    End If

    FileNameFolder = sourceDir & "Unzipped"

    If Dir(FileNameFolder, vbDirectory) = vbNullString Then
        MkDir FileNameFolder
    End If

    Set oApp = CreateObject("Shell.Application")
        oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(fileString).Items
End Sub

The last two lines are where I copy files from the zip folder into a new folder called "Unzipped". However, I'm not sure how to get at each individual file in the zip folder to say if it already exists, ignore it. Any suggestions would be greatly appreciated!

Upvotes: 1

Views: 4128

Answers (1)

Marco Rebsamen
Marco Rebsamen

Reputation: 605

Maybe this helps: (taken from: https://stackoverflow.com/a/14987890/3883521)

With oApp.NameSpace(ZipFile & "\")
  If OverwriteFile Then
     For Each fil In .Items
        If FSO.FileExists(DefPath & fil.Name) Then
           Kill DefPath & fil.Name
        End If
     Next
  End If
  oApp.NameSpace(CVar(DefPath)).CopyHere .Items
End With

Upvotes: 1

Related Questions