Sub prcReNameFolders()
Dim fso As Object, oFolder As Object
Dim strFolder As String
Application.ScreenUpdating = False
With Application.FileDialog(4)
.InitialFileName = "C:\"
.InitialView = 2
If .Show = -1 Then
strFolder = .SelectedItems(1)
End If
End With
If strFolder = "" Then Exit Sub 'Abbruch
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.getfolder(strFolder)
prcSubFolders oFolder
Application.ScreenUpdating = True
End Sub
Private Sub prcSubFolders(oFolder)
Dim oSubFolder As Object
Name oFolder As UCase(oFolder)
For Each oSubFolder In oFolder.subfolders
prcSubFolders oSubFolder
Next
End Sub
Private Sub prcSubFolders(oFolder)
Dim oSubFolder As Object
On Error GoTo ERR_EXIT
Name oFolder As UCase(oFolder)
For Each oSubFolder In oFolder.subfolders
prcSubFolders oSubFolder
Next
Exit Sub
ERR_EXIT:
MsgBox oFolder & " kann nicht umbenannt werden!" & vbLf & Err.Description
Err.Clear
Resume Next
End Sub