Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1336to1340
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Auslese und Umbenennung von Dateien

Auslese und Umbenennung von Dateien
11.11.2013 10:26:36
Dateien
Hallo zusammen,
bin noch ein Neuling was die VBA-Programmierung angeht und tue mich daher mit der Syntax etwas schwer. Und zwar geht es im Prinzip um ein Automatisierungsprozess von Dateiauslese- und Umbenennungsvorgängen.
Zum Sachverhalt:
In einem Ordner liegen Textdateien mit Namen wie:
AFAE.txt
AFAE_x.txt
AFAE_xx.txt
...
Ist ein _x bzw. ein _xx im Dateinamen vorhanden, müssen die Dateien umbenannt werden, indem das x bzw. xx ersetzt wird.
Dazu existiert eine Exceldatei. Dort steht z.B.:
AFAE
AFAE_aktiv
AFAR_001
...
Im Fall AFAE passiert nichts.
Ist ein _x im Dateinamen, soll es durch ein Wort (hier "aktiv") ersetzt werden.
Ist ein _xx im Dateinamen, soll es durch eine Zahl (hier "001") ersetzt werden.
Meine Idee ist zuerst die Dateinamen mit den Namen in der Excel zu vergleichen und je nach Bedingung _x oder _xx entsprechend umzubenennen. Allerdings weiß ich nicht wie sowas geht und ob das überhaupt möglich ist.
Hoffe das ist nicht zu kompliziert geworden und dass mir jemand helfen kann, wäre super!!
Viele Grüße,
Stefan

19
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Auslese und Umbenennung von Dateien
11.11.2013 12:37:16
Dateien
Hallo Stefan.
Hier ist ein Gerüst, um die Umbenennung in VBA zu realisieren:
Sub renaming()
Dim ltFilename As String
ltFilename = Dir()
If (ltFilename = "") Then MsgBox "Keine Dateien gefunden": Exit Sub
On Error Resume Next
Do While (ltFilename  "")
' ... hier die Datei umbenennen
' if _x _xx ...
ltFilename = Dir() 'nächste Datei suchen
Loop
End Sub

Gruß, Arthur

AW: Auslese und Umbenennung von Dateien
11.11.2013 13:03:43
Dateien
Hallo,
alles so richtig verstanden habe ich nicht!
Daher erst mal an einer Kopie der Textdateien austesten!
Die Tabelle/Range wo die Daten stehen anpassen.
Den Pfad wo die Textdateien stehen anpassen.
In einer neuen Tabelle werden Informationen ausgegeben!
Option Explicit

Sub Start()
Dim ArFile(), ArNewFile(), ArListe()
Dim n&
Dim sDir$, sPath$, sName$, sX$
Dim tmpRow
'Excelliste der Namen 
With Tabelle1
    ArListe = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Value2
End With
'Daten sortieren 
QuickSort ArListe, 1, Ubound(ArListe), 1

'Pfad angeben 
sPath = "C:\TEMP\Neuer Ordner\"

If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"

sDir = Dir$(sPath & "*.txt", vbNormal)
Do While sDir <> ""
    n = n + 1
    Redim Preserve ArFile(1 To n)
    ArFile(n) = sDir
    sDir = Dir$()
Loop

If n > 0 Then
    Redim Preserve ArNewFile(1 To Ubound(ArFile), 1 To 3)
    For n = Lbound(ArFile) To Ubound(ArFile)
        ArNewFile(n, 1) = ArFile(n)
        If InStr(ArFile(n), "_x") > 0 Then
            'extrahiere Name ohne "_x..." 
            sName = Left(ArFile(n), InStrRev(ArFile(n), "_"))
            'Suche nach Name in Liste 
            tmpRow = Application.Match(sName & "*", ArFile, 0)
            'gefunden? 
            If IsNumeric(tmpRow) Then
                tmpRow = tmpRow - 1
                'extrahiere x für anzahl zu bestimmen 
                sX = Right$(ArFile(n), Len(ArFile(n)) - InStrRev(ArFile(n), "_"))
                sX = Left$(sX, InStrRev(sX, ".") - 1)
                tmpRow = tmpRow + Len(sX)
                If Ubound(ArListe) >= tmpRow Then
                    If ArListe(tmpRow, 1) Like (sName & "*") Then
                        ArNewFile(n, 2) = ArListe(tmpRow, 1) & ".txt"
                        'Datei umbenennen 
                        If Dir$(sPath & ArNewFile(n, 2)) = "" Then
                            Name (sPath & ArFile(n)) As (sPath & ArNewFile(n, 2))
                            ArNewFile(n, 3) = "ok"
                        Else
                            'Fehler 
                            ArNewFile(n, 3) = "bereits vorhanden !!!"
                        End If
                    Else
                        'Fehler 
                        ArNewFile(n, 3) = "keine Zuordnung!"
                    End If
                End If
            End If
        Else
            ArNewFile(n, 3) = "nix gemacht!"
        End If
    Next n
Else
    MsgBox "keine Textdatei gefunden"
    Exit Sub
End If

'Ausgabe für Prüfung 
If n > 0 Then
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    With ThisWorkbook
        With .Sheets.Add(After:=.Sheets(.Sheets.Count))
            .Cells(1, 1) = "alter Name"
            .Cells(1, 2) = "neuer Name"
            .Cells(1, 3) = "Info"
            .Rows(1).Font.Bold = True
            With .Range("A2").Resize(Ubound(ArNewFile), Ubound(ArNewFile, 2))
                .Value = ArNewFile
                .EntireColumn.AutoFit
            End With
        End With
    End With
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End If
End Sub

Sub QuickSort(ByRef sArray, ByVal StartUnten As Long, ByVal EndeOben As Long, _
              ByVal LCol As Long, Optional ByVal Absteigend As Boolean = False)
Dim iUnten As Long, iOben, iMitte, y
Dim A As Long
    iUnten = StartUnten
    iOben = EndeOben
    iMitte = sArray((StartUnten + EndeOben) / 2, LCol)
    While (iUnten <= iOben)
        If Not Absteigend Then
            While (sArray(iUnten, LCol) < iMitte And iUnten < EndeOben)
                iUnten = iUnten + 1
            Wend
            While (iMitte < sArray(iOben, LCol) And iOben > StartUnten)
                iOben = iOben - 1
            Wend
        Else
            While (sArray(iUnten, LCol) > iMitte And iUnten < EndeOben)
                iUnten = iUnten + 1
            Wend
            While (iMitte > sArray(iOben, LCol) And iOben > StartUnten)
                iOben = iOben - 1
            Wend
        End If
        If (iUnten <= iOben) Then
          For A = Lbound(sArray, 2) To Ubound(sArray, 2)
            y = sArray(iUnten, A)
            sArray(iUnten, A) = sArray(iOben, A)
            sArray(iOben, A) = y
          Next A
            iUnten = iUnten + 1
            iOben = iOben - 1
            
        End If
    Wend
    If (StartUnten < iOben) Then Call QuickSort(sArray, StartUnten, iOben, LCol, Absteigend)
    If (iUnten < EndeOben) Then Call QuickSort(sArray, iUnten, EndeOben, LCol, Absteigend)
End Sub
Gruß Tino

Anzeige
AW: Auslese und Umbenennung von Dateien
11.11.2013 15:04:29
Dateien
Wow, danke für die schnellen Antworten!
Tino, habe dein Code angepasst und ausprobiert. Vielen Dank schonmal!! Was hattest du denn nicht verstanden? Wie gesagt, ich weiß selber dass es was kompliziert ist.
Komischer Weise hat es aber teilweise geklappt, teilweise nicht.
Bei AFAE kommt "nix gemacht!" wie gewünscht :)
Bei AFAE kommt allerdings "keine Zuordnung!", bloß mir fehlt an der Stelle leider das Fachwissen um zu sehen woran es liegen könnte...hast du eine spontane Idee?
Besten Dank und Grüße,
Stefan

AW: Auslese und Umbenennung von Dateien
11.11.2013 15:28:04
Dateien
Hallo,
nun ja, verstanden habe ich zBsp. die Zuordnung nicht so richtig.
(In Deiner Aufführung sollte warscheinlich AFAR_001, AFAE_001 lauten.)
Wann soll was anstelle der xxx stehen?
Ich bin jetzt einfach davon ausgegangen,
dass anhand der Anzahl der x im Textfile der Index in der Liste bestimmt wird.
Gibt es diesen Index nicht oder fängt dieser mit anderen Zeichen an
(im Beispiel AFAE...) wird "keine Zuordnung!" ausgegeben.
Beispiel für Zuordnung
 AB
1TextfileIn Liste
2AFAE.txtAFAE
3AFAE_x.txtAFAE_aktiv
4AFAE_xx.txtAFAE_001
5AFAE_xxx.txtAFAE_002
6AFAE_xxxx.txtAFAE_003
7OFOG.txtOFOG
8OFOG_x.txtOFOG_aktiv
9OFOG_xx.txtOFOG_001
10ABCD.txtABCD
11ABCD_x.txtABCD_aktiv
12ABCD_xx.txtABCD_001
13ABCD_xxx.txtABCD_002
14ABCD_xxxx.txtABCD_003
15ABCD_xxxxx.txtABCD_004

Gruß Tino

Anzeige
AW: Auslese und Umbenennung von Dateien
11.11.2013 15:44:28
Dateien
Hallo!
Oha, entschuldige, das R sollte ein E sein!!!
An Stelle eines x soll ein Wort, oder besser gesagt Buchstaben, eingefügt werden. Das kann "aktiv", "nichtaktiv", "standard", "ECE" usw. sein (also das, was in der Excel hinter dem _ steht)
An Stelle eines xx soll immer eine entsprechende Zahl aus der Excel eingefügt werden. Die sind nicht hochlaufend, sondern variieren.
Mehr als _xx gibt es nicht.
Grüße,
Stefan

AW: Auslese und Umbenennung von Dateien
11.11.2013 16:24:36
Dateien
Hallo,
"An Stelle eines x soll ein Wort"
Dies wäre immer der zweite Datensatz wie im Beispiel (den ersten gibt es aber auch immer ohne Zusatz?)
aus AFAE_x.txt wird AFAE_aktiv
aus OFOG_x.txt wird OFOG_aktiv
"An Stelle eines xx soll immer eine entsprechende Zahl aus der Excel eingefügt werden"
Wo steht diese Zahl oder wie soll diese zugeordnet?
Gruß Tino

Anzeige
AW: Auslese und Umbenennung von Dateien
12.11.2013 08:20:55
Dateien
Morgen!
Es muss nicht zwingend der zweite Datensatz sein. Ich stelle mal einen Screenshot rein, dann wird es wahrscheinlich transparenter (Info: Sind keine .txt sondern .DCM Dateien, hatte ich im Code aber angepasst)
"Wo steht diese Zahl oder wie soll diese zugeordnet?"
Die Zahl steht in einer Excel Tabelle. Auch hier mache ich am besten einen Screenshot.
Du warst davon ausgegangen, dass die xxxx hochgezählt werden, richtig? Liegt das an dem Codeauszug hier?:
Do While sDir ""
n = n + 1
ReDim Preserve ArFile(1 To n)
ArFile(n) = sDir
sDir = Dir$()
Beste Grüße,
Stefan

Anzeige
AW: Auslese und Umbenennung von Dateien
12.11.2013 08:22:40
Dateien
PS: sind die 2 Dateien die ich hochgeladen habe sichtbar?
Grüße,
Stefan

AW: Auslese und Umbenennung von Dateien
12.11.2013 11:47:19
Dateien
Hallo,
also deine 2 Dateien sind nicht sichtbar.
Ich mache dir einen Vorschlag.
Wir lesen alle Dateien ein in eine Spalte A
Danach machst Du mit Formel oder von Hand eine Zuordnung des neuen Dateinamen in Spalte B
Dann können wir anhand dieser Daten die Dateien umbenennen und evtl.
falls gewünscht in Spalte C eine Erfolgsmeldung ausgeben.
Gruß Tino

AW: Auslese und Umbenennung von Dateien
12.11.2013 13:59:55
Dateien
Hallo,
habe eine Exceldatei mit den Spalten gemacht, wie du gesagt hast. Bloß mit dem File-Upload hat das ja hier nicht funktioniert. Soll ich dir das per Mail schicken?
Viele Grüße,
Stefan

Anzeige
AW: Auslese und Umbenennung von Dateien
12.11.2013 16:15:34
Dateien
Hallo,
Du musst beim File-Upload nach dem hochladen den kompletten Text (Html Code)
im Fenster kopieren und hier in die Nachricht reinstelle.
Gruß Tino

AW: Auslese und Umbenennung von Dateien
13.11.2013 08:08:42
Dateien
Hallo,
okay hoffe das klappt jetzt!
https://www.herber.de/bbs/user/88066.xlsx
Danke für den Tip, hatte das überlesen.
So soll die Zuordnung letztendlich aussehen.
Bin deinen Code in nochmal durch gegangen. Soweit ich das beurteilen kann passt alles bis zum Punkt:
If ArListe(tmpRow, 1) Like (sName & "*") Then
Da sagt er ArListe ist "leer" und von daher überspringt den eigentlichen Umbenennungsschritt.
Grüße,
Stefan

Anzeige
AW: Auslese und Umbenennung von Dateien
13.11.2013 13:36:15
Dateien
Hallo,
die Zeile
If ArListe(tmpRow, 1) Like (sName & "*") Then
prüft ob in der aktuellen Zeile der erste Teil vom Namen der Datei enthalten ist.
z. Bsp. von der Datei Q36x-ANZEIGE_x.DCM steht in der Variablen
sName Q36x-ANZEIGE, wenn nicht gibt es in Deiner Liste keinen Eintrag mehr.
Deine Datei ist gut, aber wichtig wäre die Liste mit der Zuordnung
damit ich verstehe wo die Werte 7000, 201, N20 usw. herkommen und zugeordnet werden sollen.
Gruß Tino

AW: Auslese und Umbenennung von Dateien
13.11.2013 19:00:32
Dateien
Hallo,
ah okay, verstanden.
Ich lade nochmal 2 Screenshots hoch. Einmal mit den Dateinamen die umbenannt werden und in einem Ordner als .DCM stehen und dann die Excel-Liste (hat jeweils nur ein Auszug auf den Bildschirm gepasst), wo die Infos her kommen, wie die _x und _xx umbenannt werden sollen.
Wie gesagt, da gibt es noch dieses addon (Spalte B bis F) wann welche Zahl für das _x und _xx ersetzt werden soll.
Userbild
Userbild
Man ich hoffe du blickst überhaupt noch durch....sorry
Viele Grüße,
Stefan

Anzeige
AW: Auslese und Umbenennung von Dateien
13.11.2013 19:57:51
Dateien
Hallo,
so habe mal noch was umgebaut.
Deine List sollte wie im Beispiel von Dir bereits sortiert sein.
Sub Start()
Dim ArFile(), ArNewFile(), ArListe()
Dim n&
Dim sDir$, sPath$, sName$, sX$
Dim tmpRow

'Extention der Datei 
Const FileExt$ = ".DCM"

'Excelliste der Namen 
With Tabelle1
    ArListe = .Range("A4", .Cells(.Rows.Count, 1).End(xlUp)).Value2
End With

''Liste Sollte schon sortiert sein, sonst aktivieren 
''evtl. passt die Zuordnung dann nicht wegen der Sortierreihenfolge Zahlen/Buchstaben 
'QuickSort ArListe, 1, UBound(ArListe), 1 

'Pfad angeben 
sPath = "C:\TEMP\Neuer Ordner\"

If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"

sDir = Dir$(sPath & "*" & FileExt, vbNormal)
Do While sDir <> ""
    n = n + 1
    Redim Preserve ArFile(1 To n)
    ArFile(n) = sDir
    sDir = Dir$()
Loop

If n > 0 Then
    Redim Preserve ArNewFile(1 To Ubound(ArFile), 1 To 3)
    For n = Lbound(ArFile) To Ubound(ArFile)
        ArNewFile(n, 1) = ArFile(n)
        If InStr(ArFile(n), "_x") > 0 Then
            'extrahiere Name ohne "_x..." 
            sName = Left(ArFile(n), InStrRev(ArFile(n), "_") - 1)
            'Suche nach Name in Liste 
            tmpRow = Application.Match(sName & "*", ArListe, 0)
            'gefunden? 
            If IsNumeric(tmpRow) Then
                'extrahiere x für anzahl zu bestimmen 
                sX = Right$(ArFile(n), Len(ArFile(n)) - InStrRev(ArFile(n), "_"))
                sX = Left$(sX, InStrRev(sX, ".") - 1)
                If Len(sX) > 0 Then
                    tmpRow = tmpRow + Len(sX)
                    If tmpRow <= Ubound(ArListe) Then
                        If ArListe(tmpRow, 1) Like sName & "*" Then
                            ArNewFile(n, 2) = sName & "_" & Right$(ArListe(tmpRow, 1), _
                                                      Len(ArListe(tmpRow, 1)) - InStrRev(ArListe(tmpRow, 1), "_"))
                            ArNewFile(n, 2) = ArNewFile(n, 2) & FileExt
                            If Dir$(sPath & ArNewFile(n, 2)) = "" Then
                                'Datei umbenennen 
                                Name (sPath & ArFile(n)) As (sPath & ArNewFile(n, 2))
                                ArNewFile(n, 3) = "ok"
                            Else
                                'Fehler Datei bereits vorhanden 
                                ArNewFile(n, 3) = "Datei bereits vorhanden !!!"
                            End If
                        Else
                            ArNewFile(n, 3) = "kein passender Eintrag !!! Anzahl x = " & Len(sX)
                        End If
                    Else
                        ArNewFile(n, 3) = "kein passender Eintrag, Liste zu klein !!!"
                    End If
                End If
            Else
                'keine Daten zum Textfile gefunden 
                ArNewFile(n, 3) = "keine Daten, Liste unvollständig?!"
            End If
        Else
            ArNewFile(n, 3) = "nix gemacht, kein x im Namen!"
        End If
    Next n
Else
    MsgBox "keine Textdatei gefunden"
    Exit Sub
End If

'Ausgabe für Prüfung 
If n > 0 Then
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    With ThisWorkbook
        With .Sheets.Add(After:=.Sheets(.Sheets.Count))
            .Cells(1, 1) = "alter Name"
            .Cells(1, 2) = "neuer Name"
            .Cells(1, 3) = "Info"
            .Rows(1).Font.Bold = True
            With .Range("A2").Resize(Ubound(ArNewFile), Ubound(ArNewFile, 2))
                .Value = ArNewFile
                .EntireColumn.AutoFit
            End With
        End With
    End With
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End If
End Sub

Sub QuickSort(ByRef sArray, ByVal StartUnten As Long, ByVal EndeOben As Long, _
              ByVal LCol As Long, Optional ByVal Absteigend As Boolean = False)
Dim iUnten As Long, iOben, iMitte, y
Dim A As Long
    iUnten = StartUnten
    iOben = EndeOben
    iMitte = sArray((StartUnten + EndeOben) / 2, LCol)
    While (iUnten <= iOben)
        If Not Absteigend Then
            While (sArray(iUnten, LCol) < iMitte And iUnten < EndeOben)
                iUnten = iUnten + 1
            Wend
            While (iMitte < sArray(iOben, LCol) And iOben > StartUnten)
                iOben = iOben - 1
            Wend
        Else
            While (sArray(iUnten, LCol) > iMitte And iUnten < EndeOben)
                iUnten = iUnten + 1
            Wend
            While (iMitte > sArray(iOben, LCol) And iOben > StartUnten)
                iOben = iOben - 1
            Wend
        End If
        If (iUnten <= iOben) Then
          For A = Lbound(sArray, 2) To Ubound(sArray, 2)
            y = sArray(iUnten, A)
            sArray(iUnten, A) = sArray(iOben, A)
            sArray(iOben, A) = y
          Next A
            iUnten = iUnten + 1
            iOben = iOben - 1
            
        End If
    Wend
    If (StartUnten < iOben) Then Call QuickSort(sArray, StartUnten, iOben, LCol, Absteigend)
    If (iUnten < EndeOben) Then Call QuickSort(sArray, iUnten, EndeOben, LCol, Absteigend)
End Sub
Gruß Tino

Anzeige
AW: Auslese und Umbenennung von Dateien
15.11.2013 08:42:11
Dateien
Morgen,
leider schmeißt der bei allen Namen die umbenannt werden sollen "keine Daten, Liste unvollständig?!" raus. Bei den Namen wo nichts passieren soll passiert auch nichts wie gewünscht!
Beim Durchlauf des Blocks ab Z32 tritt für die Namen mit _x und _xx in Z43 der Fehler: tmpRow = Fehler 2042 auf. Danach überspringt er den ganzen Umbenennungsprozess. Weißt du was das bedeutet?
Grüße,
Stefan

AW: Auslese und Umbenennung von Dateien
15.11.2013 14:30:40
Dateien
Hallo,
weis nicht was bei dir anders ist,
habe alles wie von Dir beschrieben bei mir aufgebaut und dann funktioniert es.
Wenn tmpRow = Fehler 2042 ist, wird der Anfangsteil nicht in der Liste gefunden!
Gehe mal zum Zeitpunkt in dieser Zeile mit der Maus über sName, ist dieser Anfangsteil in der Liste?
Gruß Tino

Anzeige
AW: Auslese und Umbenennung von Dateien
18.11.2013 09:30:25
Dateien
Hallo,
das ist schonmal schön zu hören dass es bei dir funktioniert!
Zu dem Zeitpunkt zeigt er für sName "Q36x-ADAS" an. Eine Zeile drüber (Z38) ist jedoch für ArFile(n)der komplette Dateiname in der Variablen "Q36x-ADAS_x.DCM"
Der Fehler kommt dann wenn ich in die Zeile If IsNumeric (tmpRow) Then springe.
Kann mir den Fehler auch nicht erklären, sieht recht logisch aus was du da gezaubert hast.
Viele Grüße,
Stefan

AW: Auslese und Umbenennung von Dateien
18.11.2013 10:56:48
Dateien
Hallo,
meine Antwort von heute morgen scheint nicht angekommen zu sein..
Es ist auf jeden Fall schonmal schön zu hören dass es bei dir klappt!
Zu dem Zeitpunkt zeigt er für sName "Q36x-ADAS" an. Eine Zeile drüber (Z38) ist jedoch für ArFile(n)der komplette Dateiname in der Variablen "Q36x-ADAS_x.DCM"
Der Fehler kommt dann wenn ich in die Zeile If IsNumeric (tmpRow) Then springe.
Kann mir den Fehler auch nicht erklären, sieht recht logisch aus was du da gezaubert hast.
Viele Grüße,
Stefan

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige