Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Dateien eines Typs außer Neueste verschieben

Dateien eines Typs außer Neueste verschieben
23.05.2018 15:44:27
demo
Hallo,
ich möchte alle Dateien (*.csv) aus einem Verzeichnis verschieben. Lediglich die neueste Datei soll im Ordner verbleiben.
Danke und Gruß
demo

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dateien eines Typs außer Neueste verschieben
23.05.2018 16:25:19
UweD
Hallo
in ein Modul
Option Explicit

Sub Dateien()
    Dim FSO, F, Datei, MMax As Date, Pfad1 As String, Ext As String, Pfad2 As String, NamAlt As String
    
    On Error GoTo Fehler
    
    '**** 
    Pfad1 = "X:\Temp\"          'Von 
    Pfad2 = "X:\Temp\Test\"     'Nach 
    
    Ext = "csv"
    '**** 
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    For Each Datei In FSO.getFolder(Pfad1).Files
    
        If LCase(FSO.GetExtensionName(Datei)) = LCase(Ext) Then
            Set F = FSO.getfile(Datei)
            If NamAlt = "" Then 'im ersten Durchlauf 
                MMax = F.DateCreated
                NamAlt = Datei
            Else
                If F.DateCreated > MMax Then
                    'nächse Datei ist neuer 
                    
                    FSO.MoveFile NamAlt, Pfad2 'Ältere verschieben 
                    
                    MMax = F.DateCreated
                    NamAlt = Datei
                
                Else
                    'Diese Ältere verschieben 
                    FSO.MoveFile Datei, Pfad2 ' 
                
                End If
            End If
        End If
    Next
    
    Err.Clear
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub

LG UweD
Anzeige
AW: Dateien eines Typs außer Neueste verschieben
24.05.2018 08:13:46
demo
Hallo UweD,
zunächst einmal danke für Deine Bemühungen.
Ich habe es getestet. Leider funktioniert es nicht ganz. Das Ergebnis ist, dass er alle Dateien, mit Ausnahme der Ältesten, verschiebt. Ich habe einmal diese Zeile "If F.DateCreated > MMax Then" so modifiziert "If F.DateCreated Hast Du da vielleicht eine Lösung?
Danke und Gruß
demo
AW: Dateien eines Typs außer Neueste verschieben
24.05.2018 08:28:00
UweD
Hallo
funktioniert perfekt.
Ich habe mich auf das "created date" bezogen
ggf meinst du das LastModified date.
eretze mal überall das "F.DateCreated" durch "F.DateLastModified"
LG UweD
AW: Dateien eines Typs außer Neueste verschieben
24.05.2018 10:01:22
demo
Hallo UweD,
nun funktioniert es wie gewünscht.
Ein Frage habe ich aber noch. Die betreffenden *.csv - Dateien werden über einen nächtlichen Batchlauf erstellt. Diese heißen immer nach folgendem Schema HRO_sca_2018-05-23.csv incl. des Erstellungsdatums. Ließe sich das Verschieben auch über den Datumseintrag aus dem Dateinamen realisieren? Dann hätte ich die Gewährleistung, dass ich immer die letzte Datei im Verzeichnis hätte.
Danke und Gruß
demo
Anzeige
AW: Dateien eines Typs außer Neueste verschieben
24.05.2018 10:25:00
UweD
Hallo
das ginge z.B. so
Option Explicit

Sub Dateien()
    Dim FSO, F, Datei, MMax As Date, Pfad1 As String, Ext As String
    Dim Pfad2 As String, NamAlt As String, DDatum
    
    On Error GoTo Fehler
    
    '**** 
    Pfad1 = "X:\Temp\"          'Von 
    Pfad2 = "X:\Temp\Test\"     'Nach 
    
    Ext = "csv"
    '**** 
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    For Each Datei In FSO.getFolder(Pfad1).Files
    
        If LCase(FSO.GetExtensionName(Datei)) = LCase(Ext) Then
            DDatum = Left(Right(Datei, 14), 10)
            If Not IsDate(DDatum) Then
                MsgBox "Diese csv-Datei entspricht NICHT der Namens-Konvention" & vbLf & vbLf & _
                        Dir(Datei)
                Exit Sub
            End If
            If NamAlt = "" Then 'im ersten Durchlauf 
                MMax = DDatum
                NamAlt = Datei
            Else
                If DDatum > MMax Then
                    'Datei ist neuer 
                    
                    FSO.MoveFile NamAlt, Pfad2 'Ältere verschieben 
                    
                    MMax = DDatum
                    NamAlt = Datei
                
                Else
                    'Diese Ältere verschieben 
                    FSO.MoveFile Datei, Pfad2 ' 
                
                End If
            End If
        End If
    Next
    
    Err.Clear
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub

LG UweD
Anzeige
AW: Dateien eines Typs außer Neueste verschieben
24.05.2018 11:02:09
demo
Hallo UweD,
perfekt. Danke sehr!
Gruß demo
Danke für die Rückmeldung owT
24.05.2018 11:17:35
UweD

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige