HERBERS

Excel-Forum (Archiv)

20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Rückwärts Blättern

Aktuelles Verzeichnis

Übersicht Verzeichnisse

Nächster Thread

Vorwärts blättern

Inhaltsverzeichnis

Dateiname auf USB-Stick ändern

Forumthread: Dateiname auf USB-Stick ändern
8 Beiträge zu diesem Forumthread
Anzeige
Threads zu ähnlichen Themen
VBA Beispiele zu verwandten Themen
Top 100 Forumthreads

Forumthread: Dateiname auf USB-Stick ändern

20.06.2018 08:55:27

Peter

Hallo ihr Excelspezialisten,
ich benötige eure Hilfe zu folgendem Problem.
Ich habe die Dateinamen aus einem USB-Stick ausgelesen. Aufgrund bestimmter Umstände ist jedoch der Name nicht richtig. Dieser soll nun mit einem Wert aus einer Tabelle umbenannt werden.
Könnt ihr mir bitte bei der Lösung meines Problems helfen.
Besten Dank
Gruss Peter

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Dateiname auf USB-Stick ändern

20.06.2018 09:12:00

UweD
AW: Dateiname auf USB-Stick ändern

20.06.2018 09:55:24

Peter
Danke für die Rückmeldung owT

20.06.2018 10:22:06

UweD
AW: Danke für die Rückmeldung owT

20.06.2018 14:48:51

Peter
AW: Danke für die Rückmeldung owT

20.06.2018 15:22:52

UweD
AW: Danke für die Rückmeldung owT

20.06.2018 17:07:45

Peter
AW: Lösung gefunden

20.06.2018 17:37:43

Peter
AW: Lösung gefunden

21.06.2018 08:45:47

UweD

AW: Dateiname auf USB-Stick ändern

20.06.2018 09:12:00

UweD

Hallo
vorrausgesetzt deine Daten liegen so vor..

Tabelle1

	A	B
1	Alt	Neu
2	ABC.xlsx	NEUABC.xlsx
3	XYZ.xlsx	NeuXYZ.xlsx

http://excel-inn.de/dateien/vba_beispiele/tabellenanzeige_in_html_addin.zip

http://Hajo-Excel.de/tools.htm

XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007

Add-In-Version 25.14 einschl. 64 Bit

Sub umbenennen()
    Dim Tb, Sp As Integer, Alt As String, Neu As String, LR As Integer, i As Integer, Pfad As String
    
    Set Tb = Sheets("Tabelle1")
    Pfad = "X:\Temp\"
    Sp = 1 ' Daten in Spalte A 
    LR = Tb.Cells(Tb.Rows.Count, Sp).End(xlUp).Row 'letzte Zeile der Spalte 

    For i = 2 To LR
        Alt = Tb.Cells(i, Sp)
        Neu = Tb.Cells(i, Sp).Offset(0, 1)
        
        Name Pfad & Alt As Pfad & Neu
        
    Next
End Sub

LG UweD

AW: Dateiname auf USB-Stick ändern

20.06.2018 09:55:24

Peter

Hallo Uwe,
besten Dank für Deine schnelle Hilfe.
Wünsche noch einen schönen Tag.
Gruss Peter

Danke für die Rückmeldung owT

20.06.2018 10:22:06

UweD

AW: Danke für die Rückmeldung owT

20.06.2018 14:48:51

Peter

Hallo Uwe
habe da noch eine zusätzliche Frage.
ich habe folgende Werte welche übertragen werden, aber nur dann, wenn diese nicht identisch sind:
If Alt1 Neu1 Then
Name Pfad & Alt1 As Pfad & Neu1
end if bzw. else if
Name Pfad & Alt2 As Pfad & Neu2
Name Pfad & Alt3 As Pfad & Neu3
Name Pfad & Alt4 As Pfad & Neu4
Es folgt aber eine Fehlermeldung, wenn der Name Neu1 bereits existiert(richtigerweise)
Wie stelle ich es dann an, dass dieses if abgebrochen wird und das nächste durchgeführt wird.
Besten Dank für die Hilfe.
Gruss Peter

AW: Danke für die Rückmeldung owT

20.06.2018 15:22:52

UweD

Hi
ungeprüft

IF ALT1  Neu1 and Dir(Pfad & Neu1) "" THEN 'dann gibt es die Datei noch nicht
Name Pfad & Alt1 As Pfad & Neu1
end if

LG UweD

AW: Danke für die Rückmeldung owT

20.06.2018 17:07:45

Peter

Hallo Uwe,
ich glaube das ist noch nicht das was ich benötige.
Auf dem Stick sind vier Dateien zwei als cvs und zwei als xml Dateien. Diese haben einen Namen.
Diese Namen lese ich in eine Tabelle ein. Nun soll, sofern der Name nicht richtig geschrieben wurde,
dies überprüft werden und ggf. mit dem richtigen Namen geändert werden.
Mit folgendem Makro funktioniert dies, sofern der Name nicht richtig ist:

Sub Makro_Speichern_unter_G()
Dim Tb, Alt As String, Neu As String
Pfad = "G:\"
Set Tb = Worksheets("Hilfstabelle")
Alt = Tb.Range("AQ2")
Neu = Tb.Range("AV44")
Name Pfad & Alt As Pfad & Neu
End Sub

Wenn jedoch der Name bereits existiert, dann kommt Fehlermeldung - Datei bereits vorhanden. Wie kann ich es erreichen, dass dies dann übersprungen wird. Ich würde dies mit "exit sub" machen, dann benötige ich aber für jede ein seperates Makro. Geht dies in einem Makro?
Besten Dank
Gruss Peter

AW: Lösung gefunden

20.06.2018 17:37:43

Peter

Hallo Uwe,
habe die Sache neu in Testbereich geprüft.
Nachstehendes Makro bringt wohl die Lösung:

Sub Test_Dateiname_ändern()
Dim Tb, Alt As String, Neu As String
pfad = "C:\Users\Peter\Desktop\Test_2018_06_20_Dateinamen\"
Set Tb = Worksheets("Tabelle1")
Alt1 = Tb.Range("D4")
Neu1 = Tb.Range("E4")
Alt2 = Tb.Range("D5")
Neu2 = Tb.Range("E5")
Alt3 = Tb.Range("D6")
Neu3 = Tb.Range("E6")
On Error Resume Next
Name pfad & Alt1 As pfad & Neu1
Name pfad & Alt2 As pfad & Neu2
Name pfad & Alt3 As pfad & Neu3
If Err.Number = 53 Then
MsgBox "Konnte Datei nicht finden", vbCritical
End If
End Sub

Sieht Du eine bessere Lösung?
Gruss Peter

AW: Lösung gefunden

21.06.2018 08:45:47

UweD

Hallo
ich würde es so machen

Sub Test_Dateiname_ändern()
    Dim Tb, Pfad As String, Alt(3) As String, Neu(3) As String
    Dim i As Integer, EZ As Integer, ES As Integer
        
    Pfad = "C:\Users\Peter\Desktop\Test_2018_06_20_Dateinamen\"
    
    EZ = 4 'erste Zeile 
    ES = 4 'erste Spalte 
    
    Set Tb = Worksheets("Tabelle1")
    
    For i = 0 To 2
        Alt(i) = Tb.Cells(EZ, ES).Offset(i, 0)
        Neu(i) = Tb.Cells(EZ, ES).Offset(i, 1)
        
        If Alt(i) <> "" Then
            If Neu(i) <> "" Then
                If Dir(Pfad & Alt(i)) <> "" Then
                    If Dir(Pfad & Neu(i)) = "" Then
                
                        Name Pfad & Alt(i) As Pfad & Neu(i)
                    
                    Else
                        MsgBox Neu(i) & " gibt es schon." 'neu schon da 
                    End If
                Else
                    MsgBox Alt(i) & " nicht vorhanden." 'Alt nicht da 
                End If
            Else
                MsgBox "Ungültiger Name in " & Cells(EZ + i, ES + 1).Address 'Neu ist leer 
            End If
        Else
            MsgBox "Ungültiger Name in " & Cells(EZ + i, ES).Address 'Alt ist leer 
        End If
    Next
End Sub