Viele Ordner mit Macro umbenenen

Servus,
ich habe eine Frage an Euch bezüglich des Umbennens von einer großen Anzahl von Ordnern.
Auf meinem Laufwerk X: liegen in einer Struktur Vorgangsnummern in Unterordnern, die dringend in ein neues Format
umbenannt werden müssen. DIe umzubennennenden Ordner liegen in der 5 Ebene, sind nach Jahr Monat und Aufgabe untergliedert.
X:\Akten\2022\01 Januar\Aufträge\1234567\ X:\Akten\2022\02 Februar\Anträge\4567890\ X:\Akten\2022\02 Februar\Anträge\2345678\ Die Ordner, die aus einer 7-stelligen Zahl bestehen, müssen dringend in diese Form umbenannt werden:
X:\Akten\2022\01 Januar\Aufträge\CV-1234567-2022\ X:\Akten\2022\02 Februar\Anträge\CV-4567890-2022\ X:\Akten\2022\02 Februar\Anträge\CV-2345678-2022\ Es kommt also vor die Zahl ein CV- und nach die Jahreszahl -2022.Da es bestimmt 1000 Ordner sind wollte ich fragen, ob es dafür eine Lösung in VBA gibt, die mir das umbenennen erledigen kann. Eines gemeinsam haben alle umzubennende Ordner: Sie sind alle in der 5-Ebene und bestehen alle aus einer 7 stelligen Zahl. Alle anderen Ordner bleiben gleich!
Kann mir da jemand Schützenhilfe leisten?
LIeben Dank

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub aaaa() Dim oFSO As Object, oFldr As Object, oSFldr As Object Const strFldr = "X:\Akten\2022\01 Januar\Aufträge" Set oFSO = CreateObject("scripting.filesystemobject") Set oFldr = oFSO.getfolder(strFldr) For Each oSFldr In oFldr.subfolders Name oSFldr As oFldr.Path & "\CV-" & oSFldr.Name & "-2022" Next oSFldr End Sub

Sub Verzeichnis_umbenennen() 'mit Anbindung (Extras,Verweise..) von "Microsoft Scripting Runtime" Dim FSO As New FileSystemObject Dim F1 As Folder 'Verzeichnis (=Folder) Ebene 1 Dim F2 As Folder Dim F3 As Folder Const cPfad = "X:\Akten\2022" '\01 Januar\Aufträge" For Each F1 In FSO.GetFolder(cPfad).SubFolders 'üner alle Monate-Verzeichnisse gehen For Each F2 In F1.SubFolders Select Case F2.Name Case "Aufträge", "Anträge" For Each F3 In F2.SubFolders F3.Name = "CV-" & F3.Name & "-2022" Next F3 End Select Next F2 Next F1 End Sub

Sub umbenennen() 'Verzeichnis umbennen 'mit Anbindung (Extras,Verweise..) von "Microsoft Scripting Runtime" Dim fso As New FileSystemObject Dim F1 As Folder 'Verzeichnis (=Folder) Ebene 1 Dim F2 As Folder Dim F3 As Folder Const cPfad = "D:\Akte\2022\" ' For Each F1 In fso.GetFolder(cPfad).SubFolders 'über alle Monate-Verzeichnisse gehen For Each F2 In F1.SubFolders 'über alle Arten gehen For Each F3 In F2.SubFolders 'über alle Nummern gehen If IsNumeric(F3.Name) Then F3.Name = "CV-" & F3.Name & "-2022" 'Verzeichnis umbenennen Else Dim objFSO As Object On Error Resume Next Set objFSO = CreateObject("Scripting.FileSystemObject") MakeSureDirectoryPathExists ("D:\Fehlerhaft\" & F1.Name & "\" & F2.Name & "\" & F3.Name & "\") MsgBox ("Nachfolgendes Verzeichnis entspricht keiner konformen Struktur:" & vbCr & vbCr & cPfad & F1.Name & "\" & F2.Name & "\" & F3.Name) objFSO.CopyFolder cPfad & F1.Name & "\" & F2.Name & "\" & F3.Name, "D:\Fehlerhaft\" & F1.Name & "\" & F2.Name & "\" & F3.Name On Error Resume Next objFSO.DeleteFolder cPfad & F1.Name & "\" & F2.Name & "\" & F3.Name, True Set objFSO = Nothing End If Next F3 Next F2 Next F1 MsgBox "Fertig" End Sub

Hallo Herbie,
wenn alle Ordner umbenannt weden sollten, unabhängig des Namen der Ordner der Ebene 2 (Verzeichnis-Ebene wo "Aufträge", ... liegen) dann die 3 Zeilen Select Case, Case und End Select weglassen.
Sieht dann so aus:


Sub Verzeichnis_umbenennen()
'mit Anbindung (Extras,Verweise..) von "Microsoft Scripting Runtime"
Dim FSO As New FileSystemObject
Dim F1 As Folder 'Verzeichnis (=Folder) Ebene 1, Durch Konstante cPfad gegeben
Dim F2 As Folder 'Verzeichnis der Ebene 2: Anträge, Aufträge
Dim F3 As Folder 'Verzeichnis der Ebene 3: Verzeichnis die umbenannt werden sollten
Const cPfad = "X:\Akten\2022" '\01 Januar\Aufträge"
For Each F1 In FSO.GetFolder(cPfad).SubFolders 'üner alle Monate-Verzeichnisse gehen
For Each F2 In F1.SubFolders
For Each F3 In F2.SubFolders
F3.Name = "CV-" & F3.Name & "-2022"
Next F3
Next F2
Next F1
End Sub

Wenn einige Namen in Ebene 2 von der Umbenennung ausgeschlossen werden sollten, ist es dann einfacher einen "Case" für die Ausnahme einzurichten, wo nichts gemacht wird, und der Rest in einem Case Else:


Sub Verzeichnis_umbenennen()
'mit Anbindung (Extras,Verweise..) von "Microsoft Scripting Runtime"
Dim FSO As New FileSystemObject
Dim F1 As Folder 'Verzeichnis (=Folder) Ebene 1
Dim F2 As Folder
Dim F3 As Folder
Const cPfad = "X:\Akten\2022" '\01 Januar\Aufträge"
For Each F1 In FSO.GetFolder(cPfad).SubFolders 'üner alle Monate-Verzeichnisse gehen
For Each F2 In F1.SubFolders
Select Case F2.Name
Case "AusnahmeName1", "AusnahmeName1"
' hier wird nichts gemacht.
Case Else
For Each F3 In F2.SubFolders
F3.Name = "CV-" & F3.Name & "-2022"
'Debug.Print "Orig: " & F3.Path & ", Neu: " & "CV-" & F3.Name & "-2022"
Next F3
End Select
Next F2
Next F1
End Sub

Zum Testen kannst Du die Umbenennung in Kommentar setzen und den Debug.Print aktivieren. Ausgabe erfolgt in Direktfenster (Ansicht, Direktfenster)
VG
Yal

Dim fs Sub M_snb() Set fs = CreateObject("scripting.filesystemobject") M_snb_rec fs.GetFolder("X:\Akten\2022\01 Januar\Aufträge\") End Sub Sub M_snb_rec(it) If Val(Right(it.Name, 5)) > 10000 Then it.Name = Replace(it.Name, Right(it.Name, 5), "CV_" & Right(it.Name, 5) & "_2022") For Each it1 In it.SubFolders M_snb_rec it1 Next End Sub

Beliebteste Forumthreads (12 Monate)

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread