Klasördeki dosya isimlerini Excel (VBA) Makro Kullanarak Değiştir!
Aşağıdaki kodlar başka bir Excel kullanıcısı tarafından oluşturulmuş vba kodlarıdır. Kodlara sürekli ihtiyaç duymamdan ötürü her hangi bir revize yapmadan kaynak göstererek direk ekledim. Faydalı olması dileğimle…
Bu Kod Dizini Bulur ve A1 hücresine dizin adını yazar.
Sub DosyaYoluBul()
Dim fd As FileDialog
Dim vrtSelectedItem As Variant
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
Range("A1") = vrtSelectedItem & Application.PathSeparator
Liste Range("A1").Text
Next vrtSelectedItem
End If
End With
Set fd = Nothing
End Sub
Bu kod Bulunan Dizindeki Dosyaları Listeler, Otomatik çağrılır, ilk kod bunu yapar.
Kod:
Sub Liste(Yol As String)
Dim dosya As String, i As Long
Application.ScreenUpdating = False
i = Cells(Rows.Count, "A").End(3).Row
If i < 2 Then i = 2
Range("A2:B" & i).ClearContents
dosya = Dir(Yol & "*.*")
i = 1
While dosya <> ""
DoEvents
i = i + 1
Cells(i, 1) = dosya
dosya = Dir
Wend
End Sub
Aşağıdaki kodlar ise A sütununda listelenen (Uzantıları ile birlikte) B sütunundaki yeni adı ile değiştirilir. Yeni adı yazarken uzantıyı yazmaya gerek yok, çünkü A sütunundan uzantıyı otomatik olarak alır. B sütunundaki hücre boş ise karşılığındaki A sütunundaki dosyada değişiklik yapmaz.
Kod:
Sub Degistir()
Dim DsyBas As String, _
i As Long, _
j As Integer, _
Adt As Integer, _
Uzn As String, _
Uzanti As String, _
Yol As String
Uzn = Application.InputBox("Uzantısı Olmayan Dosyaların Uzantısı Ne Olsun?", "Sordum Gitti Valla", ".mp4", Type:=2)
Yol = Application.WorksheetFunction.Trim(Range("A1"))
If Not Right(Yol, 1) = "\" Then Yol = Yol & Application.PathSeparator
For i = 2 To Cells(Rows.Count, "A").End(3).Row
If Not Cells(i, "B") = "" Then
Adt = Adt + 1
j = InStr(1, StrReverse(Cells(i, "A")), ".", vbTextCompare)
If j > 0 Then
Uzanti = Right(Cells(i, "A"), j)
Else
Uzanti = Uzn
End If
Name Yol & Cells(i, "A") As Yol & Cells(i, "B") & Uzanti
End If
Next i
MsgBox Adt & " adet dosya adı değiştirildi...", vbInformation, "Bilgi"
End Sub
Kaynak: https://www.excel.web.tr