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 - имя файлов для копирования