Toplu olarak dosya isimlerini değiştirme

[yasin85]

Günaydın Arkadaşlar,

Sorunun nedenini anladım benim resim isimlerimde '' -_., '' gibi simgeler var bu simgeler olunca çalışmayacağını yazılmış ben şimdi fark ettim.

Bu durumda bu tarz simgeleri olan dosyaların isimlerini değiştirmek için bir yardımlarınızı bekliyorum.

Kolay Gelsin

 

[PLİNT]

Günaydın Arkadaşlar,

Sorunun nedenini anladım benim resim isimlerimde '' -_., '' gibi simgeler var bu simgeler olunca çalışmayacağını yazılmış ben şimdi fark ettim.

Sorunun ondan olacağını sanmıyorum,
Ekteki resmi "D:\" diskine atıp; excel dosyasını denermisiniz,'' -_., '' resim adında var.
http://s3.dosya.tc/server8/cihmlm/Desktop.zip.html
Hücrelerde ".jpg" uzantısı görünüyor, klasörde ".jpeg" olmasın?

 

[yasin85]

Merhaba,

Dosyanız tam istediğim gibi olmuş fakat çok enteresan sizin attığınız resimin adı değişiyor fakat benim resimler olduğu gibi kalıyor..


d:\ alanın resimlerin uzantısı ile birlikte resimde göre bilirsiniz


http://www.dosya.tc/server7/rn14sh/dosya_adi_degistirme.jpg.html

 

[yasin85]

Bu enteresan durumu çözmek isteyen uzman arkadaşlar arıyorum

 

[PLİNT]

Merhaba
Hiç bir dosyanın adı değişmiyormu? yoksa değişen oluyormu?
Bu resim dosyalarınızdan 5-10 tanesini orjinal adıyla ekleyebilirmisiniz?

 

[yasin85]

Merhaba,

Örnek resimler alt linkteki gibidir.

http://s3.dosya.tc/server8/jmx2de/Dosya_adi_degistirme.rar.html

 

[PLİNT]

Ek dosyayı inceleyiniz;

http://s3.dosya.tc/server8/ax65kl/Desktop.zip.html

İçindeki "Deneme" adlı klasörü "D:\" diskine ("D:\Deneme\") ekleyip excel dosyasını deneyiniz.

Excel dosyanızda yazılı olan uzantılar "JPG" ; iki önceki mesajınızdaki resimde görünen özelliktede
"JPG"; son mesajınızdaki resimler "JPEG" uzantılı.
"A" sütununa bu isimleri nasıl listelediniz? "B" sütununa değişecek isim ve uzantıları nasıl eklediniz anlaşılmıyor ama bu bu iki uzantıya göre kodlarınıza eklemeler yapmaya çalıştım. Hücrelerde "1jpg1374745071.jpg" bu adı "JPG" ve "JPEG" uzantılarıyla
"Deneme" klasöründe arayacak, hangi uzantılı varsa "1jpg1374745071.jpg" adı kullanıp hangi formatta bulursa o formata göre adı
değişecek

Sub isim_degistir()
Dim i As Long, say As Long, s As Long
Dim s1 As Long
Dim a As Object
If MsgBox("D:\Deneme klasörü içersindeki dosyaların isimleirini değiştirmek istiyormusunuz..!!??", _
vbYesNo + vbQuestion, Application.UserName) = vbNo Then Exit Sub
Set a = CreateObject("scripting.filesystemobject")
For i = 2 To Cells(65536, "A").End(xlUp).Row
If a.FileExists("D:\Deneme\" & Cells(i, "A").Value) = True Then
Name "D:\Deneme\" & Cells(i, "A").Value As "D:\Deneme\" & Cells(i, "B").Value
say = say + 1
Else
s = UBound(Split(Cells(i, "A").Value, ".")): If s > 0 Then s = s - 1
If a.FileExists("D:\Deneme\" & Split(Cells(i, "A").Value, ".")(s) & ".jpeg") = True Then
s1 = UBound(Split(Cells(i, "B").Value, ".")): If s1 > 0 Then s1 = s1 - 1
Name "D:\Deneme\" & Split(Cells(i, "A").Value, ".")(s) & ".jpeg" As "D:\Deneme\" & Split(Cells(i, "B").Value, ".")(s1) & ".jpeg"
say = say + 1
End If
 End If
Next i
MsgBox say & " dosya isimi değiştirildi..", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[yasin85]

Merhaba,

Sonuç hüsran yaptığım testler aşağıdaki gibidir.

Test.1 = 3 adet resim ekledim ilgili klasöre 2 adet ismi değiştir 1 adet değişmedi
Test.2 = 10 adet KB küçükleri olan resimleri aldım dosyaya gene olmadı.
Test.2 = ismi kısa olanları aldım gene olmadı.

az adetli olunca içinden bir kaç tane değiştiriyor o kadar..

yardımlarınızı bekliyorum..

Verilen makro hatasını alt linkteki resimde bula bilirsiniz.

http://www.dosya.tc/server7/3v2p9n/ISIM_DEGISTIRME_SORUNU.jpg.html

 

[PLİNT]

Merhaba
Adı değişmeyenler bulunamamış.
Eklediğiniz resimdeki hataya göre;

"A" sütunundaki aranan ismi bulmuş;
"If a.FileExists("D:\Deneme\" & Cells(i, "A").Value) = True Then"
"B" sütunundaki adla "deneme" klasöründe aynı adlı başka bir dosya bulunca hata vermiş,
aşağıdaki şekilde olursa aynı isimde başka dosya olursa satır noyu ismin başına ekleyecektir.

Sub isim_degistir()
Dim i As Long, say As Long
If MsgBox("D:\Deneme klasörü içersindeki dosyaların isimleirini değiştirmek istiyormusunuz..!!??", _
vbYesNo + vbQuestion, Application.UserName) = vbNo Then Exit Sub
Set a = CreateObject("scripting.filesystemobject")
For i = 2 To Cells(65536, "A").End(xlUp).Row
If a.FileExists("D:\Deneme\" & Cells(i, "A").Value) = True Then

If a.FileExists("D:\Deneme\" & Cells(i, "B").Value) = True Then J = i
Name "D:\Deneme\" & Cells(i, "A").Value As "D:\Deneme\" & J & "  " & Cells(i, "B").Value
J = Empty
say = say + 1
Else
s = UBound(Split(Cells(i, "A").Value, "."))
If s > 0 Then s = s - 1
If a.FileExists("D:\Deneme\" & Split(Cells(i, "A").Value, ".")(s) & ".jpeg") = True Then
s1 = UBound(Split(Cells(i, "B").Value, "."))
If s1 > 0 Then s1 = s1 - 1
If a.FileExists("D:\Deneme\" & Split(Cells(i, "B").Value, ".")(s1) & ".jpeg") = True Then J = i
Name "D:\Deneme\" & Split(Cells(i, "A").Value, ".")(s) & ".jpeg" As "D:\Deneme\" & J & "  " & Split(Cells(i, "B").Value, ".")(s1) & ".jpeg"
J = Empty
say = say + 1
End If
 End If
Next i
MsgBox say & " dosya isimi değiştirildi..", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[yasin85]

Hocam oldu bu sefer çok sağolasın..

bir durum daha var..

bazı resim isimleri başka klasöre taşımak istiyorum yaparsak resimlerle ilgili tüm ihtiyaçlarım son bulacak

resim isimlerine göre bir klasöre taşımak istiyorum

resim isimlerini almak için bu konudaki makroyu kullanmıyorum bilginize

Sub Dosya_İsimleri()
Dim ds, dc, f, s
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("D:\Deneme")
Set dc = f.Files
For Each dosya In dc
c = c + 1
Cells(c, 1) = dosya.Name
Next
End Sub




yardımlarınızı bekliyorum..

 

[PLİNT]

Hocam oldu bu sefer çok sağolasın..
bir durum daha var..
bazı resim isimleri başka klasöre taşımak istiyorum yaparsak resimlerle ilgili tüm ihtiyaçlarım son bulacak
yardımlarınızı bekliyorum..

Merhaba
Taşınacak (resim) dosya adlarının, uzantıları yazsın veya yazmasın "B" sütunda ("B1" den itibaren) olduğunu varsayarak;
"D:\Deneme" klasöründen D:\Yeni" klasörüne taşınacak:

Sub taşı()
    Dim A As Object
    Dim Klas1 As String
    Dim Klas2 As String
    Klas1 = "D:\Deneme\"
    Klas2 = "D:\Yeni"
For i = 1 To Cells(Rows.Count, "B").End(3).Row
s = UBound(Split(Cells(i, "B").Value, "."))
If s > 0 Then s = s - 1
    uzn = Split(Cells(i, "B").Value, ".")(s) & ".jp*"
    Set A = CreateObject("scripting.filesystemobject")
    A.moveFile Source:=Klas1 & uzn, Destination:=Klas2
Next
End Sub

 

[yasin85]

Hocam ellerine sağlık bu işlemde tam istediğim gibi olmuş tüm yardımlarından dolayı teşekkür ederim..

 

[dry_35]

Macro çalışıyor fakat sorunum farklı

Selamlar öncelikle.
İhtiyacım oldukça forumu takip ediyorum. Konu çok eski ama acil yardıma ihtiyacım olduğu için bir soru soracaktım.
Verdiğiniz macro çalışıyor fakat benim sorunum başka.
Benim elimde 23.433 adet .pdf dosyasından oluşan bir klasör var.
Dosya isimlerim şu şekilde;
100-AV-005-01-01 rev0A
100-BD-205-05-51 rev1B diye devam eden proje dosyalarım var.
Benim amacım son rakamdan sonra gelen boşluktan sonrasını silmek istiyorum. Yani rev0A yazan kısımı kaldırmak istiyorum.(100-AV-005-01-01 rev0A.pdf yerine 100-AV-005-01-01.pdf) Excelde numaraları eski ve yeni değiştireceğim olarak ayarladım fakat boşluktan sonrasını .pdf olarak gördüğü için "file already exist" hatası veriyor. Yani boşluktan sonrasını görmediği için değiştireceğim dosya ile aynı numaraymış gibi bir durum oluşuyor. Ama enteresandır bu hatayı veriyor fakat yaklaşık 500 adet kadarını değiştirmiş. Numaraların hepsinin sonlarını .pdf olarak da ayarladım. Anlamadığım bir durumla karşı karşıyayım lütfen bu konuda bana yardımcı olabilir misiniz ? Teşekkür ediyorum kolay gelsin hepinize.

Aşağıdaki kodlar A sütunundaki dosya isimlerini B sütunundaki dosya ismleri ile değiştiri.
Dosyaların D:\Deneme klasörü içinde olduğu varsayılmıştır.
Eğer klasör değişkse ilgili satırda değişkliği yapınız.

Sub isim_degistir()
Dim i As Long, say As Long
If MsgBox("D:\Deneme klasörü içersindeki dosyaların isimleirini değiştirmek istiyormusunuz..!!??", _
vbYesNo + vbQuestion, Application.UserName) = vbno Then Exit Sub
For i = 1 To Cells(65536, "A").End(xlUp).Row
    If Dir("D:\Deneme\" & Cells(i, "A").Value) <> "" Then
        Name ("D:\Deneme\" & Cells(i, "A").Value) As ("D:\Deneme\" & Cells(i, "B").Value)
        say = say + 1
    End If
Next i
MsgBox say & " dosya isimi değiştirildi..", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[Asri]

..Ama enteresandır bu hatayı veriyor fakat yaklaşık 500 adet kadarını değiştirmiş. Numaraların hepsinin sonlarını .pdf olarak da ayarladım. Anlamadığım bir durumla karşı karşıyayım lütfen bu konuda bana yardımcı olabilir misiniz ? Teşekkür ediyorum kolay gelsin hepinize.

Kodları denedim. Kaynak isimler dediğiniz şekilde olmasına rağmen dosya adında değişiklik yaptı. Bir sorun çıkarmadı.

500 tane değiştirdi ise, 1 ile 1000 arasında fark yoktur. Kod aynı şekilde çalışacaktır.

501. dosyaya yada excel de A501 ve B501 deki verilerine bakmak lazım.

B kolonu için EĞERSAY yapar mısınız? 1 den fazla değer verecek mi?
Yeni oluşacak isim iki defa tanımlanmış olabilir.

 

[BedriA]

Aşağıdaki kodlar A sütunundaki dosya isimlerini B sütunundaki dosya ismleri ile değiştiri.
Dosyaların D:\Deneme klasörü içinde olduğu varsayılmıştır.
Eğer klasör değişkse ilgili satırda değişkliği yapınız.

Sub isim_degistir()
Dim i As Long, say As Long
If MsgBox("D:\Deneme klasörü içersindeki dosyaların isimleirini değiştirmek istiyormusunuz..!!??", _
vbYesNo + vbQuestion, Application.UserName) = vbno Then Exit Sub
For i = 1 To Cells(65536, "A").End(xlUp).Row
    If Dir("D:\Deneme\" & Cells(i, "A").Value) <> "" Then
        Name ("D:\Deneme\" & Cells(i, "A").Value) As ("D:\Deneme\" & Cells(i, "B").Value)
        say = say + 1
    End If
Next i
MsgBox say & " dosya isimi değiştirildi..", vbOKOnly + vbInformation, Application.UserName
End Sub

Hocam bu kod aşağıdaki şekilde kullandım ancak ekteki gibi bir hata alıyorum. Yardımcı olabilir misiniz?

Sub bedri2()

Dim i As Long, say As Long
If MsgBox("C:\Azmun\Sorular20\ klasörü içersindeki dosyaların isimleirini değiştirmek istiyormusunuz..!!??", _
vbYesNo + vbQuestion, Application.UserName) = vbNo Then Exit Sub
For i = 1 To Cells(65536, "A").End(xlUp).Row
    If Dir("C:\Azmun\Sorular20\" & Cells(i, "A").Value) <> "" Then
        Name ("C:\Azmun\Sorular20\" & Cells(i, "A").Value) As ("C:\Azmun\Sorular20\" & Cells(i, "B").Value)
        say = say + 1
    End If
Next i
MsgBox say & " dosya isimi değiştirildi..", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[keskinmakas]

Merhaba..

İletmiş olduğunuz kodları bende kullandım. Çok işime yaradı. Çok teşekkür ederim.. Hepinizin emeğine ellerine sağlık..

Ancak eklemek istediğim bir husus var. Bu kodları kullanırken sadece D/Deneme içerisinde kullanabildim.

1. Farklı bir klasördeki dosyaları değiştirmek için ne yapmamız lazım.
2. 70+ dosya içerisinde 55 adet dosya ismi değiştirdi. (İsim farklılıklarından dolayıdır.) Ancak hangi dosyaları değiştirdiğini bir şekilde satır bazlı renklendirmek mümkün müdür..?