Sıkıştırılmış Dosyada (zip, rar) Bulunan Dosyaları Kopyalama/Taşıma

[aborinas]

Merhabalar,
"Ankara" adında bir ana klasör var ve bu klasörün içinde (Altındağ.zip ) şeklinde bir zip dosyası var. Bu zip dosyanın da içinde de bir klasör var (Altındağ), ve bu Altındağ klasörün içinde de (Altındağ.jpg, Altındağ.docx, Altındağ.pdf) şeklinde 3 dosya var. İsteğim bu 3 dosyayı "Başkent" adındaki bir klasörün içine kopyalamak veya taşımak.
Örnek klasör yolu:
Ankara > Altındağ.zip > Altındağ > (Altındağ.jpg, Altındağ.docx, Altındağ.pdf)

Not: bu şekilde ana klasörün içinde bir sürü dosya var ve yukarıdaki mantıkla hepsini "Başkent" klasörüne taşımak ya da kopyalamak için excel vba kodunda yardımcı olacak arkadaşlara şimdiden teşekkürler....

 

[alicimri]

Eğer zipli klasörler, Başkent klasörü ve aşağıdaki kodları yapıştıracağınız Excel dosyası aynı klasörün içinde ise

Sub UnzipAFile()
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(ThisWorkbook.Path)
For Each oFile In oFolder.Files
If Right(oFile, 3) = "zip" Then
ShellApp.Namespace(ThisWorkbook.Path & "\Başkent").CopyHere ShellApp.Namespace(ThisWorkbook.Path & "\" & oFile.Name).items
End If
Next oFile
End Sub

 

[aborinas]

Eğer zipli klasörler, Başkent klasörü ve aşağıdaki kodları yapıştıracağınız Excel dosyası aynı klasörün içinde ise

Sub UnzipAFile()
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(ThisWorkbook.Path)
For Each oFile In oFolder.Files
If Right(oFile, 3) = "zip" Then
ShellApp.Namespace(ThisWorkbook.Path & "\Başkent").CopyHere ShellApp.Namespace(ThisWorkbook.Path & "\" & oFile.Name).items
End If
Next oFile
End Sub

alicimri bey cevabınız için teşekkür ederim kot çalışıyor. şu dizini
Set oFolder = oFSO.GetFolder(ThisWorkbook.Path & "\Ankara")
şeklinde değiştirdiğimde çalışmıyor. bu şekilde değiştirmemin nedeni şu, Bir ana klasör var bu ana klasörün içinde
1- bu excel dosyası,
2- Ankara klasörü (zipli dosyalar bu klasörün içinde)
3- Başkent klasörü
münkünse bi düzeltme yapabilir miyiz?

 

[aborinas]

alicimri bey cevabınız için teşekkür ederim kot çalışıyor. şu dizini
Set oFolder = oFSO.GetFolder(ThisWorkbook.Path & "\Ankara")
şeklinde değiştirdiğimde çalışmıyor. bu şekilde değiştirmemin nedeni şu, Bir ana klasör var bu ana klasörün içinde
1- bu excel dosyası,
2- Ankara klasörü (zipli dosyalar bu klasörün içinde)
3- Başkent klasörü
münkünse bi düzeltme yapabilir miyiz?

ShellApp.Namespace(ThisWorkbook.Path & "\Başkent").CopyHere ShellApp.Namespace(ThisWorkbook.Path & "\" & oFile.Name).items
burda da düzletmeyi yapıca çalıştı, emeğiniz için teşekkür ederim.

 

[alicimri]

Eğer zipli dosyalar, ana klasörün içinde açıkta değil de, yine ana klasörün içinde Ankara isimli bir klasörün içinde ise,

Sub UnzipAFile()
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(ThisWorkbook.Path & "\Ankara")
For Each oFile In oFolder.Files
If Right(oFile, 3) = "zip" Then
ShellApp.Namespace(ThisWorkbook.Path & "\Başkent").CopyHere ShellApp.Namespace(ThisWorkbook.Path & "\Ankara\" & oFile.Name).items
End If
Next oFile
End Sub