Alle CSV-Dateien mit neuem Datum in einem Ordner mit einem VBA Makro einlesen

Hallo ich habe ein Problem Mit Makro

ich möchte 2 CSV dateien per Makro einlesen
SetMontageExport-DGS-16-04-11.csv
SetMontageExport-NDGS-16-04-11.csv

wie bekomme ich das Makro dazu immer das Aktuellste Datum zu importieren ohne das ich die alten Dateien Löschen muss .

wenn ich die Dateien umbenenne geht das alles ohne Probleme

Range("A1").Select  
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\mtmp\DGS.csv", _  
        Destination:=Range("$A$1"))  
       
        .Name = "DGS"  
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Range("A33").Select  
    ActiveWindow.SmallScroll Down:=-15
    Range("A33").Select  
   Dim s As String
Dim i As Long
With ActiveSheet
    i = 3
    Do
        i = i + 1
        s = Cells(i, "A")  
        If Len(s) = 0 Then
            Cells(i, "A").Activate  
            Exit Do
        End If
    Loop While i < 65535
End With
freeRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
  With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\mtmp\NDGS.csv", _  
        Destination:=Range("A" & freeRow))  
        .Name = "NDGS"  
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 2
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

[Edit Biber] Codeformatierung, sonst wird es wohl keiner lesen wollen. [/Edit]

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 301507

Url: https://administrator.de/forum/alle-csv-dateien-mit-neuem-datum-in-einem-ordner-mit-einem-vba-makro-einlesen-301507.html

Ausgedruckt am: 01.05.2025 um 06:05 Uhr

1 Kommentar

Moin.
Die neueste Datei eines Ordners bekommst du so:

'Bestimmte Dateien eines Verzeichnisses in ein Recordset einlesen und Absteigend nach Datum sortieren  
Function getNewestFiles(strFolder,strEXT)
	Set objList = CreateObject("ADOR.Recordset")  
	Set fso = CreateObject("Scripting.Filesystemobject")  
	objList.Fields.Append "name", 200, 255  
	objList.Fields.Append "date", 7  
	objList.Open
	For Each file In fso.GetFolder(strFolder).Files
		If LCase(fso.GetExtensionName(file.Path)) = LCase(strEXT) Then
			objList.AddNew
			objList("name").Value = file.Path  
			objList("date").Value = file.DateLastModified  
			objList.Update
		End If
	Next
	objList.Sort = "date DESC"  
	Set getNewestFiles = objList
	Set fso = Nothing
	Set objList = Nothing
End Function

'Neueste Datei in Variable speichern  
strNewestFile = getNewestFiles("C:\mtmp","csv")("name").Value  
' und testweise ausgeben ...  
MsgBox strNewestFile