Klasördeki verileri almak

[igultekin2000]

iyi günler; masaüstünde " Beyanname " klasörü var. Klasörün içinde de değişik isimlerde klasörler var. Her bir klasörün içinde .pdf uzanlı belgeler var. bu belgeleri klasörsüz olarak " Topla " klasörüne toplu olarak almak istiyorum. Yani değişik klasörün içindeki .pdf uzantılı belgeler " Beyanname/topla klasörüne belge olarak toplamak şeklide. Teşekkürler.

 

[ÖmerBey]

Merhaba,
Alt klasörlerlerde benzer isimde dosyalar mevcut mu?

 

[igultekin2000]

Merhaba,
Alt klasörlerlerde benzer isimde dosyalar mevcut mu?

isimlerin hepsi farklı

 

[ÖmerBey]

Şu kodu bir deneyin Mustafa Altun'un dosya isimlerini listeleme için yazdığı kodun düzenlenmiş halidir.

Sub Dosya_Listele()
Set ds = CreateObject("Scripting.FileSystemObject")
anayol = CreateObject("WScript.Shell").SpecialFolders("desktop") & "\Beyanname"
yol = anayol
Columns(1).Clear
Application.ScreenUpdating = False
Do
Tekrar:
If ds.GetFolder(yol).subfolders.Count > 0 Then
    For Each kls In ds.GetFolder(yol).subfolders
        If kls <> anayol & "\topla" Then klslst = klslst & "{" & kls
    Next
End If
x = x + 1
deg = Split(klslst, "{")
yol = deg(x)
dosya = Dir$(yol & "\*.*")
Do While dosya <> ""
Say = Say + 1
ds.CopyFile yol & "\" & dosya, anayol & "\topla\" & dosya
dosya = Dir$()
Loop
If x = 1 And ds.GetFolder(yol).subfolders.Count > 0 Then GoTo Tekrar
Loop While UBound(deg) <> x
End Sub

 

[igultekin2000]

Şu kodu bir deneyin Mustafa Altun'un dosya isimlerini listeleme için yazdığı kodun düzenlenmiş halidir.
Teşekkür ederim, makro sorunsuz çalışıyor, iyi çalışmalar.

 

[ÖmerBey]

Rica ederim,
Bir de koda ilave olarak dosyaları kopyalamak yerine taşımak isterseniz ds.CopyFile yazan yeri ds.MoveFile ile değiştirebilirsiniz.
İyi çalışmalar...

 

[igultekin2000]

Rica ederim,
Bir de koda ilave olarak dosyaları kopyalamak yerine taşımak isterseniz ds.CopyFile yazan yeri ds.MoveFile ile değiştirebilirsiniz.
İyi çalışmalar...

bu notuda makroya ilave ettim, genelde copy kullanıyorum. Teşekkürler