... ich habe von "Euch" ein schönes Makro bekommen!
Sub RenameFolder()
Dim oFS As Object, oFolder As Object
Dim sFolder As String
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then sFolder = .SelectedItems(1)
End With
If sFolder "" Then
Set oFS = CreateObject("Scripting.filesystemobject")
Set oFolder = oFS.getfolder(sFolder)
RenameSubFolder oFolder
If Len(oFolder.Name) > 6 Then
Name oFolder As _
Left(oFolder.Name, 6) _
& Replace(Mid(oFolder.Name, 7), "_", " ")
End If
End If
End Sub
Sub RenameSubFolder(oFolder As Object)
Dim oSubFolder As Object, oFile As Object
For Each oSubFolder In oFolder.subfolders
For Each oFile In oFolder.Files
If Len(oFile.Name) > 6 Then
Name oFile As oFile.Path _
& "\" & Left(oFile.Name, 6) _
& Replace(Mid(oFile.Name, 7), "_", " ")
End If
Next
RenameSubFolder oSubFolder
If Len(oSubFolder.Name) > 6 Then
Name oSubFolder As _
oFolder.Path & "\" _
& Left(oSubFolder.Name, 6) _
& Replace(Mid(oSubFolder.Name, 7), "_", " ")
End If
Next
End Sub
dieses Makro hat die "Aufgabe" ein selektiertes Verzeichnis und dessen Unterverzeichnisse sowie und dessen Datei- Namen zu Checken.
Es sollen die Verzeichniss - und Dateinamen wie folgt angepasst werden.
z. B. (alt)
Verzeichnisname:
01_000_mit viel Arbeit
Dateinamen:
01_002 Haus_123
02_001_Maus
03_005_Klaus_mit_der Maus ....
hier soll der Unterstrich nach der 6 Stelle entfernt werden.
(neu)
Verzeichnisname:
01_000 mit viel Arbeit
Dateinamen:
01_002 Haus 123
02_001 Maus
03_005 Klaus mit der Maus
Der Unterstrich an der dritten Stelle soll bleiben.
Ich bekomme immer ein Laufzeitfehler/ bzw. es werden nur die Verzeichnisnamen angepasst!
Vielen Dank im Voraus!
Gruß
Lemmi