Dateien auf Laufwerk nach xls umbennen

Forumthread: Dateien auf Laufwerk nach xls umbennen

23.01.2019 13:16:18

Florian

Hi,
da meine VBA Kenntnisse schon sehr eingerostet sind und ich bei dieser Sache nichts falsch machen will frage ich doch mal lieber die Profis ;)
Ich würde gerne eine ganze Menge Daten anhand einer xls Datei umbennen.
Die xls ist folgend aufgebaut:
Spalte 1 = "Laufende Nummer"
Splate 3 = "Name"
Die Daten liegen alle auf einem Laufwerk (Z:) und sind einzeln in Ordnern mir der "Laufende Nummer" als Ordnername abgelegt. Die Dateiendung ist unterschiedlich und sollte beibehalten werden.
Am liebsten wäre es mir wenn man vor dem Durchlauf des Markos noch den zu bearbeitenden Bereich (von Zeile x bis y) einstellen kann.
Gibt es hierfür eine simple Lösung ?
P.S.: Ich habe auf den Rechner hier noch das gute alte Excel 2007 ;)
Vielen Dank schon mal für euren Input.
Flo

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Dateien auf Laufwerk nach xls umbennen

23.01.2019 13:58:26

Sepp

Hallo Flo,
da fehlt noch eine Info.
Wie heißen die Dateien vor der Umbenennung und wie sollen sie danach heißen?

	A	B	C	D	E	F
1	Gruß Sepp
2
3

AW: Dateien auf Laufwerk nach xls umbennen

23.01.2019 14:03:23

Florian

Hi Sepp,
oh sorry ;) Das sind ja eher essentielle Infos ^^
Der Dateiname soll danach dem "Name" aus Spalte 3 entsprechen(Dateiendung sollte beibehalten werden).
Der Dateiname vorher ist immer verschieden und entspricht keiner Logik. Allerdings befindet sich auch immer nur eine Datei in einem Ordner.
Grüße,
Flo

AW: Dateien auf Laufwerk nach xls umbennen

23.01.2019 14:22:33

Sepp

Hallo Flo,
Modul Modul3

Option Explicit 
 
 
Sub renameFiles() 
  Dim strPath As String, strFile As String, strNew As String 
  Dim lngRow As Long 
 
  On Error Resume Next 
   
  With Sheets("Tabelle1") 'Tabellenname - Anpassen 
    For lngRow = 2 To Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row) 
      strPath = "Z:\" & .Cells(lngRow, 1).Text 
      If Right(strPath, 1) <> "\" Then strPath = strPath & "\" 
      strFile = Dir(strPath & "*", vbNormal) 
      If Len(strFile) Then 
        strNew = .Cells(lngRow, 3) & Mid(strFile, InStrRev(strFile, ".")) 
        Name strPath & strFile As strPath & strNew 
      End If 
    Next 
  End With 
  Err.Clear 
End Sub 
 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Den Tabellennamen musst du anpassen, außerdem habe ich angenommen, dass die Ordnernamen ab Zeile 2 stehen.

	A	B	C	D	E	F
1	Gruß Sepp
2
3

AW: Dateien auf Laufwerk nach xls umbennen

23.01.2019 14:45:37

Florian

HI Sepp,
ein Traum, vielen vielen Dank ;) Gerade getestet und macht genau was es soll.
Sogar an die 2te Zeile hast du gedacht ;))
Gruß,
Flo

AW: Dateien auf Laufwerk nach xls umbennen

23.01.2019 14:19:44

UweD

Hallo
&gt&gt Gibt es hierfür eine simple Lösung ?

Modul1

Option Explicit 
 
Private Sub Umbenennen() 
    On Error GoTo Fehler 
    Dim TB1, i%, Von As Long, Bis As Long, Pfad As String 
    Dim Datei As String, Neu As String, Ext As String 
    Dim Sp As Integer, ZE As Integer, LR As Long, Z As Long 
     
    '*** Stammdaten Anfang 
    Set TB1 = ActiveSheet 
    Pfad = "x:\Temp\Test\" 
     
    Sp = 1 'Spalte A 
    ZE = 1 'ab Zeile 
    '*** Stammdaten Ende 
     
    ' \ am Ende prüfen 
    Pfad = IIf(Right(Pfad, 1) = "\", Pfad, Pfad & "\") 
     
    'Pfad prüfen 
    If Dir(Pfad, vbDirectory) = "" Then 
        MsgBox Pfad & ": existiert nicht" 
        Exit Sub 
    End If 
     
     
    With TB1 
        LR = .Cells(.Rows.Count, Sp).End(xlUp).Row 'letzte Zeile der Spalte 
         
        Von = InputBox("Ab Zeile", "Dateien umbenennen", ZE) 
        Bis = InputBox("Bis Zeile", "Dateien umbenennen", LR) 
             
        If Von > LR Or Bis > LR Or Von > Bis Then 
            MsgBox "Angaben prüfen" 
            Exit Sub 
        End If 
         
        'Reset Kommentar 
        .Columns(3).ClearContents 
         
        For i = Von To Bis 
                 
            With .Cells(i, Sp) 
                If .Value <> "" And .Offset(, 1) <> "" Then 
                 
                    Datei = Dir(Pfad & .Value & ".*") 'Datei im Verz. finden 
                     
                    If Datei <> "" Then 
                        Ext = Mid(Datei, InStrRev(Datei, ".")) 'Endung ermitteln 
                        Neu = .Offset(, 1) & Ext 'Neuer Name plus Endung 
                         
                        'umbenennen 
                        Name Pfad & Datei As Pfad & Neu 
                         
                        'Kommentar 
                        .Offset(, 2) = "umbenannt" 
                        Z = Z + 1 
                    End If 
                End If 
            End With 
        Next 
     
    End With 
    MsgBox Z & "   Dateien umbenannt", vbExclamation 
     
    '*** Fehlerbehandlung 
    Err.Clear 
Fehler: 
    Application.EnableEvents = True 
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear 
End Sub

LG UweD

AW: Dateien auf Laufwerk nach xls umbennen

23.01.2019 14:35:48

UweD

hab das mit den Unterverzeichnissen wohl falsch verstanden
hier die Änderung
Modul1

Option Explicit 
 
Private Sub Umbenennen() 
    On Error GoTo Fehler 
    Dim TB1, i%, Von As Long, Bis As Long, Pfad As String, UPfad As String 
    Dim Datei As String, Neu As String, Ext As String 
    Dim Sp As Integer, ZE As Integer, LR As Long, Z As Long, K As Integer 
     
    '*** Stammdaten Anfang 
    Set TB1 = ActiveSheet 
    Pfad = "x:\Temp\Test\" 
     
    Sp = 1 'Spalte A 
    ZE = 1 'ab Zeile 
    K = 4 ' Spalte für Kommentar 
    '*** Stammdaten Ende 
     
    ' \ am Ende prüfen 
    Pfad = IIf(Right(Pfad, 1) = "\", Pfad, Pfad & "\") 
     
    'Pfad prüfen 
    If Dir(Pfad, vbDirectory) = "" Then 
        MsgBox Pfad & ": existiert nicht" 
        Exit Sub 
    End If 
     
     
    With TB1 
        LR = .Cells(.Rows.Count, Sp).End(xlUp).Row 'letzte Zeile der Spalte 
         
        Von = InputBox("Ab Zeile", "Dateien umbenennen", ZE) 
        Bis = InputBox("Bis Zeile", "Dateien umbenennen", LR) 
             
        If Von > LR Or Bis > LR Or Von > Bis Then 
            MsgBox "Angaben prüfen" 
            Exit Sub 
        End If 
         
        'Reset Kommentar 
        .Columns(K).ClearContents 
         
        For i = Von To Bis 
                 
            With .Cells(i, Sp) 
                If .Value <> "" And .Offset(, 2) <> "" Then 
                    UPfad = .Value & "\" 
                    If Dir(Pfad & UPfad, vbDirectory) = "" Then 
                        MsgBox Pfad & UPfad & "    gibt es nicht" 
                        Exit Sub 
                    End If 
                     
                    Datei = Dir(Pfad & UPfad & "*.*") 'Datei im UnterVerz. finden 
                     
                    If Datei <> "" Then 
                        Ext = Mid(Datei, InStrRev(Datei, ".")) 'Endung ermitteln 
                        Neu = .Offset(, 2) & Ext 'Neuer Name plus Endung 
                         
                        'umbenennen 
                        Name Pfad & UPfad & Datei As Pfad & UPfad & Neu 
                         
                        'Kommentar 
                        .Cells(i, K) = "umbenannt" 
                        Z = Z + 1 
                    End If 
                End If 
            End With 
        Next 
     
    End With 
    MsgBox Z & "   Dateien umbenannt", vbExclamation 
     
    '*** Fehlerbehandlung 
    Err.Clear 
Fehler: 
    Application.EnableEvents = True 
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear 
End Sub

LG UweD

AW: Dateien auf Laufwerk nach xls umbennen

23.01.2019 14:47:40

Florian

Hi UweD,
Vielen DANK ! Funktioniert super ;)
Sogar mit Eingabe-boxen für Anfang und Ende ! TOP !
Gruß,
Flo

Prima! Danke für die Rückmeldung. owT

23.01.2019 14:56:25

UweD

AW: Dateien auf Laufwerk nach xls umbennen

23.01.2019 14:45:04

Piet

Hallo Florian
am einfachsten ist es eine fertige Datei aus einem anderen Forum zu nehmen und sie ein wenig umzustricken.
Das Problem hat ein Kollege schon im Jahr 2018 gelöst, damit kann man aber nur einen Ordner umbenennen.
Schau mal ob das für dich brauchbar ist. Würde mich freuen.
Mein Einsatz war die Ergaenzung des Makros, das fehlende Datei Endungen automatisch von der alten Datei übernommen werden!
Das entspricht ja deinem Wunsch, und war im Original NICHT vorgesehen!
mfg Piet
https://www.herber.de/bbs/user/127025.xls

AW: PC war nicht aktualisiert ....

23.01.2019 15:08:37

Piet

Hallo an alle
Upps, mein PC war nicht aktualisiert! Habe beim Suchen in meinem Archiv nicht mitbekommen das schoın viele gute Lösungen vorlagen. Nun ja, was solls .... - eine Lösung mehr im Forum für kleinere Aufgaben mit nur einem Ordner ...
mfg Piet

Beliebteste Forumthreads (12 Monate)

Dateien auf Laufwerk nach xls umbennen

Forumthread: Dateien auf Laufwerk nach xls umbennen

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread