Klasördeki Dosyaları Excelden İsimlendirme

[anemis]

Merhabalar;

Bir excel dosyası içerisindeki listede yazanları o dosyanın içerisinde bulunduğu klasörlerdeki dosyaların isimleri yapabilir miyiz? (uzantısı değişmeden) Yani;

Excel içerisindeki listenin 1. sıradaki yazan ABC ise, klasör içerisindeki 1. dosyayı ABC.pdf
listedeki 2. dosya ismi XYZ ise klasördeki ikinci dosya XYZ.dwg

vs. şeklinde gidecek..

Umarım anlatabilmişimdir ve yapılabilecek birşeydir.

Örnek dosyayı ekliyorum içerisinde de bazı açıklamalar yaptım.

Şimdiden teşekkürler.

 

[ragnorak]

GivenLocation = fx & "\"
OldFileName = ListBox1.List(ListBox1.ListIndex, 0) ' dosyanın ismi'
Filename = Right$(OldFileName, Len(OldFileName) - InStrRev(OldFileName, "."))
NewFileName = URUN_ADI.Value & "." & Filename
Name GivenLocation & OldFileName As GivenLocation & NewFileName

URUN_ADI.Value yeni ad
fx klasör yolu

 

[anemis]

Sayın @ragnorak ilgi ve desteğinize teşekkürler.

Bir başka forumdan değerli @ÖmerBey ihtiyacımı karşıladı. Buradan da kodları paylaşırsam sanıyorum ki kendisi rahatsız olmaz. Arşivde dursun, belki ilerde başka bir arkadaşın da ihtiyacı olur benzer bir kod.

Sub kod()
Set klsr = CreateObject("Shell.Application").BrowseforFolder(0, "Klasör seçin", 50, &H0)
If Not klsr Is Nothing Then
    yol = klsr.Self.Path & "\"
Else
    Exit Sub
End If
ReDim d(0)
dsy = Dir(yol)
Do While dsy <> ""
    ReDim Preserve d(x)
    d(x) = dsy
    x = x + 1
    dsy = Dir
Loop

On Error GoTo hata
For a = LBound(d) To UBound(d)
    uz = "." & CreateObject("Scripting.FileSystemObject").GetExtensionName(d(a))
    Name yol & d(a) As yol & Cells(a + 4, "B") & uz
Next
MsgBox "İşlem tamam"
Exit Sub
hata:
MsgBox a + 4 & " satırında hata oluştu"
End Sub

 

[halit3]

Alternatif olarak aşağıdaki linki irdeliyebilirsiniz.

https://www.excel.web.tr/threads/klasoer-isim-degistirme-kopyalama-tasima-makro-calismasi.179250/