Dateinamen in Pfad ändern inkl. SVerweis
13.12.2023 20:52:00
Parker
ich habe mir ein Video angeschaut, in dem Dateinamen mit einem Makro geändert werden. Dabei ging es in dem Video nur um einen Teil des Namens, der immer wiederkehrend ist, ziemlich einschränkend ist. Ich benötige mehr Variabilität. Ich habe Musik/Video-Titel, die fortlaufende Nummern haben und möchte sie gerne in den korrekten Namen umbenennen.
Dazu habe ich:
Pfad in A1 kopiert
Alle Dateinamen in Spalte D2:D292 eingetragen und in Spalte E2:E292 alle neuen Namen zur Umbenennung
Das Makro soll nun (in Schleife) jeden Namen (mittels SVerweis, wenn jemand eine andere Lösung hat, geht das auch) im Pfad (nacheinander) mit den Dateinamen in Spalte D abgleichen, wenn der passende gefunden ist, ihn mit dem Namen daneben in Spalte E ersetzen.
Sub Ordner_Auslesen()
'Bibliothek aktivieren
'Variablen dimensionieren
Dim fso As Object
Dim rng As Range
Dim sPfad As String
Dim Dateiliste As Variant
Dim Datei As Variant
'Pfad auslesen
sPfad = ActiveSheet.Range("A1").Value
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(sPfad) Then
'Alle Dateien des Ordners einlesen
Set Dateiliste = fso.GetFolder(sPfad).Files
'Schleife über alle Dateien des Ordners
For Each Datei In Dateiliste
'Datei Ausgeben
Debug.Print Datei.Name
Set rng = ActiveSheet.Range("D2:D292").Find(what:=Datei.Name, LookIn:=xlValues, LookAt:=xlWhole)
If Not rng Is Nothing Then
Datei.Name = Replace(Datei.Name, rng.Value, rng.Offset(, 1).Value)
End If
Next Datei
Else
MsgBox "Dieser Ordner existiert nicht."
End If
End SubDas Makro läuft gut durch, er gibt mir auch im Direktbereich alle gefundenen Daten aus, aber er ersetzt nichts. Wo ist der Fehler?
Vielen Dank für eure Unterstützung!