Klasor içerisindeki Resimlerime Yeni İsim verme

[Kemal Demir]

Arkadaslar Selam,

Sub İsimver()
dosya1 = InputBox("Resim Dosyasının Adresini Giriniz")
.
.
.
.
End Sub

Yukarıdaki İlgili Yerleri Nasıl Doldurabilir.

Örnek:"C:\Documents and Settings\cati\Desktop\Deneme\" klasoru içerisindeki resimlerin isimlerini 1 den başlama suretı ile naısl değiştirebilirim.

Teşekkurler.

 

[Recep İpek]

Aşağıdaki kodları deneyebilirmisiniz?

Yazdığınız klasör içindeki farklı adlardaki .jpg dosyalarını Resim1.jpg, Resim2.jpg, Resim3.jpg ... şeklinde adlarını değiştirir.

Resim yazısını kendinize göre göre değiştirebilirsiniz.

Kendi dosyalarınıza uygulamadan önce klasörün yedeğini almanızı öneririm.

Sub Değiştir()
Dim sPath As String, sNameOld As String
Dim sName As String
Dim i As Long
dosya1 = InputBox("Resim Dosyasının Adresini Giriniz", "UYARI", "C:\Deneme")
With Application.FileSearch
    .NewSearch
    .LookIn = dosya1
    .SearchSubFolders = True
    .Filename = ".jpg"
    .FileType = msoFileTypeExcelWorkbooks
    If .Execute() > 0 Then
        For i = 1 To .FoundFiles.Count
           Set wkbk = Workbooks.Open(.FoundFiles(i))
           sPath = wkbk.Path
           If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
           sNameOld = wkbk.FullName
           'sName = wkbk.Worksheets(1).Range("A1").Value
           sName = "Resim" & i & ".jpg"
           wkbk.Close SaveChanges:=False
           Name sNameOld As sPath & sName
           
        Next i
    Else
        MsgBox "Dosya Bulunamadı."
    End If
End With
End Sub

 

[Levent Menteşoğlu]

Alternatif olarak aşağıdaki koduda deneyebilirsiniz.

[LEFT]Sub addegistir()
For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder("C:\Documents and Settings\cati\Desktop\Deneme\").Files
c=c+1
Name "C:\Documents and Settings\cati\Desktop\Deneme\" & dosya.Name As "C:\Documents and Settings\cati\Desktop\Deneme\" & c & ".jpg"
Next
End Sub[/LEFT]

Benzer bir konu,

http://www.excel.web.tr/showthread.php?t=18672&highlight=dosya+ad%FD

 

[Recep İpek]

Hocam sizin kodlarınız daha süper...

Teşekkürler..

 

[Kemal Demir]

Teşekkurler Arkadaslar.

 

[Kemal Demir]

Tekrar Kusura bakmayınız.

Kod istediğim sonucu vermedi desem umarım anlayıs gösterirsiniz.

 

[Recep İpek]

Kodları aynen mi kullandınız yada ilave yaptınız mı?

İlave yaptı iseniz kodlarınızı ekleyebilirmisiniz.?

 

[Kemal Demir]

Sn.Ripek

Sub Değiştir()
Dim sPath As String, sNameOld As String
Dim sName As String
Dim i As Long
dosya1 = InputBox("Resim Dosyasının Adresini Giriniz", "UYARI", "C:\Documents and Settings\cati\Desktop\yehhu\")
With Application.FileSearch
.NewSearch
.LookIn = dosya1
.SearchSubFolders = True
.Filename = ".jpg"
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Set wkbk = Workbooks.Open(.FoundFiles(i))
sPath = wkbk.Path
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sNameOld = wkbk.FullName
'sName = wkbk.Worksheets(1).Range("A1").Value
sName = "Resim" & i & ".jpg"
wkbk.Close SaveChanges:=False
Name sNameOld As sPath & sName

Next i
Else
MsgBox "Dosya Bulunamadı."
End If
End With
End Sub

Ama Ben Buarda Masa Ustunde Yehhu Dosyası içerisindeki Örnek:45ad.jpg resminin ismini Dosyasını 1.jpg ,as521.jpg isimli resimi 2.jpg gibi sıralı değerler vermeye calıstım ama bana devamlı xls dosyası açmaya calsıyor ben sadece resim dosyalarının ismini değiştirmeyi düşünüyorum.

 

[Recep İpek]

dosya1 = InputBox("Resim Dosyas&#305;n&#305;n Adresini Giriniz", "UYARI", "C:\Documents and Settings\cati\Desktop\yehhu\")


sat&#305;r&#305;ndaki son "\" i&#351;aratini silebilirmisiniz?


Sn.leventm hocam&#305;n kodlar&#305;n&#305; kullanman&#305;z&#305; tavsiye ederim.

 

[siar]

L&#252;tfen ukelal&#305;k olarak olarak alg&#305;lamay&#305;n ama g&#246;r&#252;nce dayanam&#305;yorum. Say&#305;n hitab&#305;n&#305;n k&#305;saltmas&#305;nda kullan&#305;lacak ifade "Sn." d&#305;r. &#199;ok yap&#305;lan Sn: hatas&#305;na d&#252;&#351;meyiniz. Tekrar &#246;z&#252;r dilerim, konuyla &#231;ok alakas&#305;z oldu...

 

[Recep İpek]

semihtorunlar,

Uyar&#305;n&#305;z i&#231;in te&#351;ekk&#252;r.Gerekli d&#252;zeltmeyi yapt&#305;m.

 

[Kemal Demir]

Sn.Ripek Gerekli düzenlemeyi Yaptım ama Yine xls formatında açmaya calısıyor desem , sinerlenmessiniz umarım.

Sn.Leventm Bu sözü yazmak hiç istemezdim ama kodu çalıtıramadım.Olmadı Desem

Bir yerde atladıgım birşey mi var acaba?

Teşekkur Ederim.

 

[Levent Menteşoğlu]

kodu çalıtıramadım.Olmadı Desem

Kod hatamı veriyor, yoksa işlevini yerinemi getirmiyor.

 

[Recep İpek]

Sn.kemaldemir

.FileType = msoFileTypeExcelWorkbooks

sat&#305;r&#305;n&#305;

.FileType = msoFileTypePhotoDrawFiles

olarak de&#287;i&#351;tirebilirmisiniz?

Bende her ikiside problemsiz &#231;al&#305;&#351;&#305;yor..

 

[Kemal Demir]

Ripek ve Leventm Günaydın,

Leventm ßey Dediğiniz üzeri kod daki hata olarak adlandırdıgım durum istrediğim işlevi gerçekleştiremedim.

Sn.Ripek Değişen bir şey olmadı desem.

Bu konudada fazla üstelemek(ısrarcı) olmak istemiyorum.

Çok Teşekkur Ederim.

 

[Recep İpek]

Sn.kemaldemir,

Bende &#351;&#252;pheye d&#252;&#351;t&#252;m.Normalde &#231;al&#305;&#351;mas&#305; gerekiyor.San&#305;r&#305;m biryeri yanl&#305;&#351; anl&#305;yoruz.

Ama Ben Buarda Masa Ustunde Yehhu Dosyas&#305; i&#231;erisindeki &#214;rnek:45ad.jpg resminin ismini Dosyas&#305;n&#305; 1.jpg ,as521.jpg isimli resimi 2.jpg gibi s&#305;ral&#305; de&#287;erler vermeye cal&#305;st&#305;m ama bana devaml&#305; xls dosyas&#305; a&#231;maya cals&#305;yor ben sadece resim dosyalar&#305;n&#305;n ismini de&#287;i&#351;tirmeyi d&#252;&#351;&#252;n&#252;yorum.

Yehhu Dosyas&#305; i&#231;erisindeki

Yehhu klas&#246;r m&#252; yoksa herhangi bir dosya m&#305;?

 

[Kemal Demir]

Sn.Ripek ve Sn.Leventm Oldu

Sorunu Geç fark ettim ama sonucta oldu.

Sorun:Listede isimleri aynı olanlar vardı Sade Minik Bir ilave ekledim.

Sub İsimver()
For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder("C:\Documents and Settings\cati\Desktop\yehhu\").Files
c = c + 1
Name "C:\Documents and Settings\cati\Desktop\yehhu\" & dosya.Name As "C:\Documents and Settings\cati\Desktop\yehhu\" & Resim& & c & ".jpg"
Next
End Sub

Sn.Ripek Sizin kodunuzlada calıstı .

Tekrar tekrar teşekkur ederim.