Vba При копировании файлов из ZIP Нужно не копировать файлы расширения SIG

В zip файле есть файлы Расширения SIG и их копировать не нужно но как это сделать не понимаю

Sub Unzip()
    Dim FSO As Object
    Dim oApp As Object
    Dim Fname
    Dim FileNameFolder As Variant
    Dim DefPath As String
    Dim x As Integer
 
    Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
                                        MultiSelect:=True)
    If TypeName(Fname) = "Boolean" Then
        MsgBox "Вы ничего не выбрали!"
        Exit Sub
    End If
        
        DefPath = "C:\Users\Ass\Downloads\TEST"
        If Right(DefPath, 1) <> "\" Then
            DefPath = DefPath & "\"
        End If
        x = 1
        While x <= UBound(Fname)
        FileNameFolder = DefPath
         
        
        Set oApp = CreateObject("Shell.Application")
        oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname(x)).Items
        
        x = x + 1
        Wend
  
        
        MsgBox "You find the files here: " & FileNameFolder
                 
        On Error Resume Next
        Set FSO = CreateObject("scripting.filesystemobject")
        FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
     
End Sub

Ответы (1 шт):

Автор решения: Алексей Абрамов

Спасибо всем, нашел все таки способ копировать определенные файлы Вместо этих строчек

        Set oApp = CreateObject("Shell.Application")
        oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname(x)).Items

(копирование всех файлов архива)

Нужно использовать

        With CreateObject("Shell.Application").Namespace((DefPath))
        .CopyHere Fname(x) & "\" & "0.xlsx"
        End With
        x = x + 1
        Wend

Где 0.xlsx - имя файлов для копирования

→ Ссылка