Klasör ismini değiştirmek

[vivident]

Merhaba

"R1_FOL_66-70828_Backup_20170619" buna benzer klasör isimlerim var. Bende şunu yapmaya çalışıyorum Soldan R1 ile başlayan klasör var ise uzantısı silerek ismini R1 yapmak

"R2_ABC_66-70828_Backup_20170619" Soldan R2 ile başlıyor. Uzantısını silerek ismini R2 yapmak

Yalnız aşağıdaki kodda dosya isimleri değişiyor, klasör isimlerini değiştiremiyorum. Kodda nasıl bir modif yaparız

Sub Adlandir()
Dim Dosya As String, Klasor As String, i As Integer
 
Klasor = "" & ThisWorkbook.Path & "\referans\"
Dosya = Dir(Klasor)
 
    If Left(Dosya, 2) = "R1" Then
    Name Klasor & Dosya As Klasor & _
        "R1" & Right$(Dosya, 4)
    Dosya = Dir
    End If
End Sub

 

[antonio]

Sub klasor_isimlerini_degistir()
Dim fso As Object, ref As Object, kls As Object
Set fso = CreateObject("scripting.filesystemobject")
yol = ThisWorkbook.Path & "\referans\"
Set ref = fso.getfolder(yol)
Set kls = ref.subFolders
For Each yeni In kls
    yeni.Name = Left(yeni.Name, 2)
Next yeni
End Sub

 

[vivident]

sayın antonio
verdiğiniz kod ile işlem yapılıyor, çok teşekkür ederim

biraz da öğrenmek amacı ile soruyorum, benim paylaştığım kodda ki eksiklik nedir ? hangi kodu eklersem, sonuç alırım

 

[antonio]

Ad değişikliği yapmak istediğiniz klasörler; referans klasörünün alt klasörleri durumundadırlar. (subfolders) Sizin kodlardaki hata, bu alt klasörleri tanımlayacak bir döngü bulundurmamasıdır. Klasör işlemlerinde Scripting.FileSystemObject Nesnesini kullanırsanız, dosya ve klasör işlemlerini daha rahat halledersiniz.