Ordner automatisiert umbenennen

Forumthread: Ordner automatisiert umbenennen

13.12.2016 10:09:31

Nico

Hallo!
Ich habe ein Problem was mich sehr viel Zeit kosten wird, wenn es keine elegante Lösung gibt und ich hoffe, ihr könnt mir helfen ...
Ich habe in Zelle A1 einen Speicherpfad eines Ordners eingetragen. In diesem Ordner liegen 400 Unterordner, die ich nun automatisiert umbenennen möchte. Die alten Namen stehen in A5:A405, die neuen Namen in B5:B405. Hierbei soll der Name eines Ordners immer mit dem entsprechenden Namen in der jeweiligen Zeile ersetzt werden.
Gibt es eine Möglichkeit, das über ein VBA-Makro zu erledigen?
Danke & Grüße,
Nico

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Ordner automatisiert umbenennen

13.12.2016 10:15:37

Rainer
AW: Ordner automatisiert umbenennen

13.12.2016 13:56:40

Nico
AW: Ordner automatisiert umbenennen

13.12.2016 13:00:03

Tino

AW: Ordner automatisiert umbenennen

13.12.2016 10:15:37

Rainer

Hallo Nico,
auch wenn es hier ein Excel Forum ist, aber dafür würde ich eine andere Software empfehlen.
Ich benutze dafür "advanced renamer". Damit kann man unter anderem anhand einer Liste Dateien und Ordner umbenennen.
Gruß,
Rainer

AW: Ordner automatisiert umbenennen

13.12.2016 13:56:40

Nico

Hallo Rainer!
Das funktioniert prima. Dankeschön!
Grüße,
Nico

AW: Ordner automatisiert umbenennen

13.12.2016 13:00:03

Tino

Hallo,
hier mal eine Variante zum testen!

Option Explicit

Sub Beispiel()
Dim FSO As Object
Dim ArData, ArErg()
Dim sPath$
Dim n&

'Grund Pfad wo die Ordner sind 
sPath = ThisWorkbook.Path


With Tabelle1 'Tabelle anpassen 
    If .Cells(.Rows.Count, 1).End(xlUp).Row < 5 Then Exit Sub
    ArData = .Range("A5", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 2)
    Redim ArErg(1 To Ubound(ArData), 1 To 1)
End With

sPath = IIf(Right$(sPath, 1) <> "\", sPath & "\", sPath)
Set FSO = CreateObject("Scripting.FileSystemObject")

On Error Resume Next
For n = 1 To Ubound(ArData)
    If ArData(n, 1) <> "" Then 'Spalte A nicht leer 
        If ArData(n, 2) <> "" Then 'Spalte b nicht leer 
            If FSO.folderExists(sPath & ArData(n, 1)) Then 'Ordner Spalte A vorhanden 
                If Not FSO.folderExists(sPath & ArData(n, 1)) Then 'Ordner Spalte B nicht vorhanden 
                    FSO.Getfolder(sPath & ArData(n, 1)).Move (sPath & ArData(n, 2))
                    
                    If Err.Number <> 0 Then 'sonsige Fehler 
                        ArErg(n, 1) = Err.Description
                        Err.Clear
                        Err.Number = 0
                    Else 'alles ok 
                        ArErg(n, 1) = "ok"
                    End If
                Else
                    ArErg(n, 1) = "Bereits vorhanden"
                End If
            Else
                ArErg(n, 1) = "Ordner gibt es nicht"
            End If
        Else
            ArErg(n, 1) = "Fehler Spalte B"
        End If
    Else
        ArErg(n, 1) = "Fehler Spalte A"
    End If
Next n

'Ausgabe Info 
With Tabelle1
    .Range("C5").Resize(Ubound(ArErg)) = ArErg
End With
End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

Forumthread: Ordner automatisiert umbenennen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread