Dosya adlandırmak

[sicilyali]

Arkadaşlar, bu sitede ve birçok yerde aradım fakat bulamadım; konunun yeri umarım doğrudur. Benim sorunum; bir klasör içindeki dosya isimlerinin (.tiff dosyaları) exceldeki 2 sütun halinde eşleştirilmiş listedeki isimlerle değiştirilmesi konusunda yardımlarınızı rica ediyorum. Örneğin klasördeki 100a.tiff dosyasının isminin excel listemdeki karşılığı 102122.tiff olup, benim istediğim excel sütunundaki 102122.tiff ismi gerçekte olan dosya ismimle yerdeğiştirmesi.
Birçok toplu dosya adlandırma programına baktım ne yazıkki hiç biri dışardan import dosyası alıp isim değiştirmiyor.
Önerebileceğiniz bir program var mıdır? lütfen yardımcı olun ismi düzenlenecek 20.000'e yakın veri var elimde. İlginize şimdiden teşekkürler.
Saygılarımla.

 

[Necdet]

Merhaba,

Sorunuzu pek anlamadım ama :

A sütununda Dosyanın Eski Adı, B sütununda ise Yeni Adı olduğunu ve dosyanında ilgili dizinde olduğu varsayarak Aşağıdaki kodları deneyiniz.

Sub DosyaDuzenle()
 
    On Error Resume Next
    Dim EskiAd, _
        YeniAd, _
        Yol     As String, _
        i       As Long
        
    Yol = ThisWorkbook.Path & Application.PathSeparator
    
    For i = 1 To Cells(Rows.Count, "A").End(3).Row
        EskiAd = Yol & Cells(i, "A")
        YeniAd = Yol & Cells(i, "B")
        Name EskiAd As YeniAd
        If Err.Number <> 0 Then Cells(i, "C") = "DOSYA BULUNMADI"
    Next i
 
End Sub

 

[sicilyali]

Merhaba,

Sorunuzu pek anlamadım ama :

A sütununda Dosyanın Eski Adı, B sütununda ise Yeni Adı olduğunu ve dosyanında ilgili dizinde olduğu varsayarak Aşağıdaki kodları deneyiniz.

Sub DosyaDuzenle()
 
    On Error Resume Next
    Dim EskiAd, _
        YeniAd, _
        Yol     As String, _
        i       As Long
        
    Yol = ThisWorkbook.Path & Application.PathSeparator
    
    For i = 1 To Cells(Rows.Count, "A").End(3).Row
        EskiAd = Yol & Cells(i, "A")
        YeniAd = Yol & Cells(i, "B")
        Name EskiAd As YeniAd
        If Err.Number <> 0 Then Cells(i, "C") = "DOSYA BULUNMADI"
    Next i
 
End Sub

Sayın, Necdet Yeşertener yardımlarınız için teşekkürler fakat makro konusunda çok yeniyim ve hep hazır kullandığım için; dosya dizini ismimi nereye yazmam gerekiyor (örnek olarak siz boşlukları doldurur musunuz lütfen) onuda belirtirseniz sevinirim.
Ayrıca bu makro ile istediğim dizindeki dosya adları excel listemdeki dosya adları ile değişecek mi?
Acil yardımlarınız için çok çok teşekkürler, konu benim için çok önemli 20.000 dosya söz konusu

 

[Necdet]

Merhaba,

Dosya dizinini yazmaya gerek yok, iş basit olsun diye aşağıda vereceğim dosyanın bulunduğu dizindeki dosya isimlerini değiştirir.

Dosyayı inceleyiniz.

 

[sicilyali]

Merhaba,

Dosya dizinini yazmaya gerek yok, iş basit olsun diye aşağıda vereceğim dosyanın bulunduğu dizindeki dosya isimlerini değiştirir.

Dosyayı inceleyiniz.

Çok teşekkür ederim, denedim çalışıyor; elinize sağlık. Pazartesi günü işyerimde istediğim 20.000 dosya üzerinde deneyeceğim, işimi oldukça kolaylaştıracak.
Tekrar sağolun.

 

[sicilyali]

Kusura bakmayın sürekli problem çıkartıyorum ama, olması gereken dosya adı sütunu (B sütunu) çiftliyorsa (yani aynı dosya adı birden çok yazılmış ise) makro onları değiştirmiyor, dolayısıyla onlara da bir döngü ile dosyaadı_1, dosyaadı_2, dosyaadı_3 diye isimler vermesi mümkün mü?
Biliyorum şansımı çok zorluyorum ama lütfen yardımcı olun.
Saygılarımla.

 

[Necdet]

Dosya Adını Değiştirme

Merhaba,

Bir işi yaptıkça hataların ortaya çıkması doğal.

Kod aşağıdaki hali aldı, umarım işinize yarar.

Sub DosyaDuzenle()
    On Error Resume Next
    Dim EskiAd, _
        YeniAd, _
        Yol     As String, _
        i       As Long, _
        Adet    As Integer, _
        a
        
    Yol = ThisWorkbook.Path & Application.PathSeparator
    Application.ScreenUpdating = False
    Range("C:C").ClearContents
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
        EskiAd = Yol & Cells(i, "A")
        YeniAd = Yol & Cells(i, "B")
        Name EskiAd As YeniAd
        If Err.Number <> 0 Then
            If Err.Number = 53 Then
                Cells(i, "C") = Cells(i, "A") & " Adlı Dosya Bulunamadı"
            ElseIf Err.Number = 58 Then
                a = Split(Cells(i, "B"), ".")
                Adet = Application.WorksheetFunction.CountIf(Range("B2:B" & i - 1), Cells(i, "B"))
                YeniAd = Yol & a(0) & "_" & Adet & "." & a(1)
                Name EskiAd As YeniAd
                Cells(i, "C") = "Mükerrer Yeni Ad : " & a(0) & "_" & Adet & "." & a(1)
            Else
                Cells(i, "C") = "Hata Var, Kod : " & Err.Number
            End If
        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox "Dosyalar Değiştirilmiştir....", vbInformation, "N.YEŞERTENER --> [URL="http://www.excel.web.tr"]www.excel.web.tr[/URL]"
    
End Sub

 

[sicilyali]

Yine olmadı bu kezde B sütununda tekrar eden numaralı dosyayı siliyor yada değişikliği yapmıyor.
Kodun Elseif kısmında Yeniad kısmı sanırım çalışmıyor, ne yapılabilir.
Siz denediğinizde istediğiniz sonucu aldınız mı? benden mi kaynaklanıyor sorun acaba.
Teşekkürler.

 

[Necdet]

Merhaba,

Ben anladığımı yaptığımı sanıyıorum, anladığımı da denedim çalıştı. Yani :

a.txt dosyasını abc.txt
b.txt dosyasını abd.txt
c.txt dosyasını abc.txt yapmak istediğinizi varsayalım

olması gereken dosya adlarında abc.txt 2 adet var

birinci a.txt dosyasını abc.txt yapıyor
3. sıradaki c.txt dosyasını yine abc.txt yapamadığı için bunu abc_1.txt yapıyor

ben bunu anladım kodu da buna göre yaptım.

 

[sicilyali]

Merhaba,

Ben anladığımı yaptığımı sanıyıorum, anladığımı da denedim çalıştı. Yani :

a.txt dosyasını abc.txt
b.txt dosyasını abd.txt
c.txt dosyasını abc.txt yapmak istediğinizi varsayalım

olması gereken dosya adlarında abc.txt 2 adet var

birinci a.txt dosyasını abc.txt yapıyor
3. sıradaki c.txt dosyasını yine abc.txt yapamadığı için bunu abc_1.txt yapıyor

ben bunu anladım kodu da buna göre yaptım.

Evet aynen böyle istiyorum, ama olmadı.
İkinci kez tekrarlayan abc.txt dosyasını yapmıyor (sizin gönderdiğiniz makroyu çalıştırıyorum 200.txt aynen kalıyor hiçbir değişiklik olmuyor diğerleri değişiyor).

 

[Necdet]

Merhaba,

Evet haklısınız, küçük bir hata yapmışım, bunu da 7. mesajımda kodları düzelttim. Dosyayı yeniden inceleyiniz.

 

[sicilyali]

Mükemmel olmuş, ellerinize sağlık.

 

[Necdet]

Mükemmel olmuş, ellerinize sağlık.

Güle güle kullanınız.