Sehr viele Dateien umbenennen aus Zelle

Patrick Walke · 2024-06-03T10:22:58+00:00

Hallo VBA-ler. Ich habe ein Problem auf den Tisch bekommen was nach Makro ruft...ich finde aber keine Antwort. Es existieren >1000 Dateien in einem Verzeichnis d:\beschreibung. Diese Dateinamen sind recht willkürlich gewählt (viele Anwender, keine Vorgabe). Nun will ich diese sortieren indem ich aus der jeweiligen Datei aus Zelle H1 eine Projektnummer (5-stellig) auslese und damit dann die Datei umbenenne in "Projektnummer_alter-Dateiname.xlsx". Hier muss ich vermutlich mit einem Makro in einer externen Datei auf das Verzeichnis zugreifen? Hat jemand hier eine Idee wie das klappen kann? Danke, Patrick

HI
mal ein Lösungsansatz.
du musst die umzuwandelnden Dateien zuerst auswählen.
Dabei kannst du alle Dateien in einem Verzeichnis auswählen (Multiselect mit Shift, STRG oder auch STRG+a für alle)
allerdings müssen die Projektnummern immer auf gleichbenannten Tabellenblättern liegen, da du den Tabellenblattnamen im Code festlegen musst.
das Makro ignoriert andere Dateitypen, dh es stört nicht, wenn da mal ein PDF oder so dazwischen ist

Sub Umbenenen()

Dim Dateien

Dim DateiAlt

Dim DateiNeu As String

Dim Datei As String

Dim Ordner As String

Dim PNr As Variant

Dateien = Application.GetOpenFilename(MultiSelect:=True)

If VarType(Dateien) = vbBoolean Then Exit Sub 'abbruch



For Each DateiAlt In Dateien

    If DateiAlt Like "*.xls?" Then

        Ordner = Left(DateiAlt, InStrRev(DateiAlt, "\"))

        Datei = Mid(DateiAlt, InStrRev(DateiAlt, "\") + 1)

        PNr = Evaluate("='" & Ordner & "[" & Datei & "]Tabelle1'!H1") 'hier Tabellenblattname anpassen

        If Not IsError(PNr) Then  'prüfung, ob Evaluate den Wert ermitteln konnte (wenn nicht, anderer Blattname)

            If PNr Like "?????" Then ' Prüfung Projektnummer korrekt (5stellig)

                DateiNeu = Ordner & Evaluate("='" & Ordner & "[" & Datei & "]Tabelle1'!H1") & " " & Datei

                Name DateiAlt As DateiNeu

            End If

        End If

    End If

Next





End Sub

Gruß Daniel

HI
nö, eigentlich sollte das funktionieren.
hast du mal weiter getestet?
sind die erzeugten Dateinamen (DateiNeu) korrekt?
betrifft der Fehler grundsätzlich alle Dateien (Fehler tritt schon beim ersten Schleifenumlauf auf) oder tritt er erst später auf?
funktioniert der Code, wenn du ihn mal in einem "einfachen" Verzeichnis, also auf deiner Festplatte (C:\Test}\... oder so ) ausführst?
könnte es sein, dass eine der Dateien von jemand anderem geöffnet ist und diese daher nicht umbenannt werden kann?

wenn du die alte Datei nochmal testen willst, ändere bitte diese Zeile noch so ab:

DateiNeu = Ordner & PNr & " " & Datei

zum testen im Einzelstep setzte bitte einen Haltepunkt nach dem GetOpenFilename

wenn das NAME das Problem ist, könntest du es auch so probieren:
wobei das vermutlich länger dauert, da jede Datei geöffnet wird und gespeichert wird.

Sub Umbenenen()

Dim Dateien

Dim DateiAlt

Dim DateiNeu As String

Dim Datei As String

Dim Ordner As String

Dim PNr As Variant

Dim wb as workbook

Dateien = Application.GetOpenFilename(MultiSelect:=True)

If VarType(Dateien) = vbBoolean Then Exit Sub 'abbruch



For Each DateiAlt In Dateien

    If DateiAlt Like "*.xls?" Then

        Ordner = Left(DateiAlt, InStrRev(DateiAlt, "\"))

        Datei = Mid(DateiAlt, InStrRev(DateiAlt, "\") + 1)

        Set wb = Workbooks.Open DateiAlt

        PNr = wb.Sheets("Tabelle1").Range("H1").value

        If Not IsError(PNr) Then  'prüfung, ob Evaluate den Wert ermitteln konnte (wenn nicht, anderer Blattname)

            If PNr Like "?????" Then ' Prüfung Projektnummer korrekt (5stellig)

                DateiNeu = Ordner & PNr & " " & Datei

                wb.SaveCopyAs DateiNeu

                wb.Close false

                kill DateiAlt 'alte datei löschen

            else

                wb.Close false

            End If

        else

               wb.Close false

        End If

    End If

Next





End Sub

Gruß Daniel

Sehr viele Dateien umbenennen aus Zelle

Forumthread: Sehr viele Dateien umbenennen aus Zelle

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Sehr viele Dateien umbenennen aus Zelle

Forumthread: Sehr viele Dateien umbenennen aus Zelle

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread